Wijzigingen.

.gitignore

@@ -19,3 +19,4 @@ compiled/
 *.dep
 
 /*.bak
+/gui/*.bak

dlna-player.rkt

@@ -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"))))

dlna.rkt

@@ -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))
+        )
+    )
+  )

gui.rkt

@@ -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")
+             (wv-menu-item 'm-file (tr 'file)
-                     #:submenu
+                           #:submenu (wv-menu 'file-menu
-                     (wv-menu
+                                              (wv-menu-item 'm-select-library-dir (tr 'select-library-dir))
-                      (wv-menu-item 'm-add-tab (tr "Add Playlist"))
+                                              (wv-menu-item 'm-settings (tr 'settings))
-                      (wv-menu-item 'm-select-library-dir (tr "Select Music Library Folder"))
+                                              (wv-menu-item 'm-quit (tr 'quit) #:separator #t)
-                      (wv-menu-item 'm-set-lang (tr "Set language"))
-                      (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%
@@ -43,6 +61,7 @@
       [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))
@@ -59,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)
@@ -78,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)))
         )
       )
 
@@ -113,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)
@@ -146,11 +184,21 @@
               (unless (eq? stored-file #f)
                 (dbg-rktplayer "Setting album art")
                 (let ((el (send this element 'album-art)))
-                  (let ((html (format "<img src=\"/get-image?~a&~a\" />"
+                  (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))))))
                     )))
               )
             )
@@ -172,15 +220,26 @@
       )
 
     (define (update-state st)
-      (dbg-rktplayer "state: ~a" st)
       (unless (eq? st state)
         (dbg-rktplayer "Changing to state ~a" st)
-        (unless (eq? state #f) ; Prevent setting src twice very fast 
+        (let ((el (send this element 'paused)))
-          (if (eq? st 'playing)
+          (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)
         )
       )
@@ -228,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-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-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-add (tr 'add-playlist) #:callback (λ () (send this add-tab)))
                      )
                    )
             )
@@ -296,11 +355,14 @@
       (send playlist add-tab!)
       (send this update-tabs))
 
-    (define (update-audio-info samples rate channels bits audio-format)
+    (define (update-audio-info rate channels bits audio-format)
-      (send el-bits set-innerHTML! (format "~a ~a" bits (tr "bits")))
+      (let ((format-num (λ (x) (if (= x 0) "-" x)))
-      (send el-channels set-innerHTML! (format "~a ~a" channels (tr "channels")))
+            (format-dec (λ (x) (if (eq? x 'none) "-" x))))
-      (send el-rate set-innerHTML! (format "~a Hz" rate))
+        (send el-bits set-innerHTML! (format "~a ~a" (format-num bits) (tr 'bits)))
-      (send el-format set-innerHTML! (format "~a" audio-format))
+        (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)
@@ -314,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]
@@ -322,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))
 
@@ -375,23 +487,32 @@
       (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)
       (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))
@@ -401,6 +522,46 @@
                   )
                 )
               )
+        (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)
@@ -425,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))
           )
@@ -469,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))
@@ -493,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])))
@@ -510,9 +688,10 @@
       (send this update-playlist)
       )
 
-    (define/public (open-booklet path)
+    (define/public (open-booklet path . is-file*)
-      (let ((booklet (build-path path "booklet.pdf")))
+      (let* ((is-file (if (null? is-file*) #f (eq? (car is-file*) #t)))
-        (dbg-rktplayer "Open booklet ~a" path)
+             (booklet (if is-file path (build-path path "booklet.pdf"))))
+        (dbg-rktplayer "Open booklet ~a" booklet)
         (open-app booklet)))
 
     (define/public (open-folder path)
@@ -525,7 +704,7 @@
       (cond
         ((eq? state 'playing)
          (send player pause!))
-        ((eq? state 'pauzed)
+        ((eq? state 'paused)
          (send player play!))
         (else
           (play-track 0))
@@ -567,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
@@ -594,27 +774,40 @@
       (send player quit)
       (set! closed #t)
       (send this close)
+      (dbg-rktplayer "Calling super -> quit")
       (super quit)
       )
 
-    (define/public (select-library)
+    (define/public (settings-dlg)
-      (let ((dir (send this choose-dir
+      (let ((dlg (new settings% [settings (send settings clone 'settings-dlg)]
-                       (tr "Choose the folder containing your music library")
+                   [parent this])))
-                       (if (string? music-library) music-library (path->string music-library))
+        (send dlg show)))
-                       )))
+
-        (if (eq? dir 'showing)
+
-            'done
+    (define/public (show-hide)
-            (unless (eq? dir #f)
+      (let ((st (send this window-state)))
-              (set! music-library dir)
+        (if (eq? st 'hidden)
-              (send settings set! 'music-library dir)
+            (send this present)
-              (set! current-music-path #f)
+            (send this hide)
-              (send this update-library)
-              )
             )
         )
       )
 
+    (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)))
@@ -622,6 +815,7 @@
       (set! playlist (new playlist% [settings (send settings clone 'playlists)]))
       (send player set-list! playlist)
       (dbg-rktplayer "playlist = ~a" playlist)
+
       (semaphore-post initialized)
       )
     )

gui.rkt-autorec.gui

@@ -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)
+      )
+    )
+  )
+
+

gui/library-dialog.html

@@ -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>

gui/rktplayer.html

@@ -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">
@@ -49,8 +49,12 @@
 	        </div>
        </div>
        <div class="status">
-			<span class="info" id="bits"></span><span class="info" id="rate"></span><span class="info" id="channels"></span>
+			<span class="info" id="bits"></span>
+			<span class="info" id="rate"></span>
+			<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>

gui/settings.html

@@ -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>

gui/styles.css

@@ -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;
 }
@@ -336,5 +384,30 @@ input.v-slider {
 }
 
 
+.blink {
+	animation: blink 3s infinite both;
+}
+
+@keyframes blink {
+  0%,
+  50%,
+  100% {
+    opacity: 1;
+  }
+  25%,
+  75% {
+    opacity: 0;
+  }
+}
+
+
+select, option {
+  all: revert;
+}
+
+.pane {
+  display: block !important;
+}
+
 
 

info.rkt

@@ -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)
+
+

libraries.rkt

@@ -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))))
+
+    ))

music-library.rkt

@@ -1,6 +1,6 @@
 #lang racket
 
-(require racket-sound)
+(require racket-audio)
 
 (provide music-lib-relevant?
          is-music-dir?
@@ -16,7 +16,7 @@
           (not (string-prefix? name ".")))
         (if (eq? type 'file)
             (let* ((fn (string-downcase (format "~a" f)))
-                   (exts (audio-supported-extensions)))
+                   (exts (audio-known-exts?)))
               (let ((l (filter (λ (e) (string-suffix? fn (string-append "." e))) exts)))
                 (not (null? l))))
             #f))))

player.rkt

@@ -1,14 +1,13 @@
 #lang racket
 
 (require racket/class
-         racket-sound
+         racket-audio
          "utils.rkt"
+         lru-cache
          )
 
 (provide player%)
 
-(define orig-current-seconds current-seconds)
-
 (define player%
   (class object%
     (init-field [settings #f]
@@ -20,375 +19,225 @@
                 [buffer-max-seconds 10]
                 [buffer-min-seconds 4]
                 )
-    (define use-ao #t)
 
-    (define pl #f)
+    (define player-kind  'local)
+    (define player-host  #f)
+    (define player-basepaths #f)
+    
+    (define player       #f)
+    (define playlist     #f)
     (define state        'stopped)
-    (define track -1)
+    (define repeat       'no-repeat)
-    (define current-track -1)
-    (define ct-data #f)
-    (define closing #f)
-    (define pause #f)
-    (define repeat-state 'no-repeat)
-    (define volume (send settings get 'volume 100.0))
 
-    (define ao-handle #f)
+    (define full-state   (make-hash))
-    (define audio-handle #f)
+    (define music-id     -1)
+    (define track-cache (make-lru 10
+                                   #:cmp (λ (a b) (= (car a) (car b)))))
 
-    (define current-music-id -1)
-    (define current-track-id -1)
 
-    (define current-rate 0)
+    (define (music-id->track-nr id)
-    (define current-bits 0)
+      (let ((item (lru-use track-cache (list music-id) #f)))
-    (define current-channels 0)
+        (if (eq? item #f)
-    (define current-audio-format 'none)
+            #f
+            (cadr item))))
 
-    (define current-length 0)
+    (define (register-music-id&track-nr id track-nr)
-    (define current-seconds 0)
+      (lru-add! track-cache (list id track-nr)))
 
-    (define repeat 'no-repeat)   ;; no-repeat, repeat-1, repeat-all
+    (define (clear-music-ids!)
+      (lru-clear track-cache))
 
-    (define play-time-updater-state 'stopped)
 
-    (define (set-state! st)
+    ;;(define x 0)
-      (set! state st)
+    (define (audio-state-cb handle player-state st*)
-      (state-updater st))
+      (set! full-state st*)
-
+      ;;(when (< x 5)
-    (define (check-ao-handle)
+      ;;  (displayln st*)
-      (when (eq? ao-handle #f)
+      ;;  (set! x (+ x 1)))
-        (unless (or (= current-rate 0) (= current-bits 0) (= current-channels 0))
+      (unless (or (not (eq? player handle)) (eq? player #f))
-          (dbg-rktplayer "current-rate = ~a, current-bits = ~a, current-channels = ~a, ao-handle = ~a"
+        (let ((st (audio-state player)))
-                         current-rate current-bits current-channels ao-handle)
+          (when (or (eq? st 'paused) (eq? st 'playing))
-          (dbg-rktplayer "Opening ao-handle")
+            (time-updater (audio-at-second player)
-          (when use-ao
+                          (audio-duration player))
-            (set! ao-handle (ao-open-live current-bits current-rate current-channels 'native-endian))
+            (when (not (= music-id (audio-music-id player)))
-            (start-play-time-updater)
+              (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")
-      (when (not (= (ao-volume ao-handle) volume))
+                    (track-nr-updater track-nr))))
-        (ao-set-volume! ao-handle volume))
-      )
-
-    (define (start-play-time-updater)
-      (when (eq? play-time-updater-state 'stopped)
-        (set! play-time-updater-state 'updating)
-        (dbg-rktplayer "Starting play-time-updater")
-        (thread (λ ()
-                  (define (updater)
-                    (if (or (eq? ao-handle #f) closing)
-                        (begin
-                          (set! play-time-updater-state 'stopped)
-                          (dbg-rktplayer "Terminating play-time-updater")
-                          'done)
-                        (let ((seconds (ao-at-second ao-handle))
-                              (duration (ao-music-duration ao-handle))
-                              (music-id (ao-at-music-id ao-handle))
-                              )
-                          (set! current-seconds seconds)
-                          (time-updater current-seconds duration)
-                          (unless (= music-id current-music-id)
-                            (dbg-rktplayer "a ~a ~a ~a" music-id current-track-id seconds)
-                            (set! current-music-id music-id)
-                            (track-nr-updater track))
-                          (sleep 0.2)
-                          (updater))))
-                  (updater)
             )
+          (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)
+      (when (and (eq? player handle) (not (eq? player #f)))
+        (let ((track-nr (music-id->track-nr music-id)))
+          (send this next))))
 
-    (define (stream-equal? rate bits channels)
-      (and (= current-rate rate)
-           (= current-bits bits)
-           (= current-channels channels)))
 
-    (define (audio-play type ao-type handle buf-info buffer buf-len)
+    ;(define ap (make-audio-player audio-player-state audio-player-eof
-        (unless (eq? state 'quitted)
+    ;  #:remote-host "hans@mahler.thuis.local"
-          (let* ((sample (hash-ref buf-info 'sample))
+    ;  #:replace-base-paths '(("\\\\panderleou\\music" . "/muziek"))))
-                 (rate (hash-ref buf-info 'sample-rate))
+    (define (check-player)
-                 (second (/ (* sample 1.0) (* rate 1.0)))
+      ;(displayln "check-player called")
-                 (bits-per-sample (hash-ref buf-info 'bits-per-sample))
+      (when (eq? player #f)
-                 (bytes-per-sample (/ bits-per-sample 8))
+        (set! player
-                 (channels (hash-ref buf-info 'channels))
+              (if (eq? player-kind 'local)
-                 (bytes-per-sample-all-channels (* channels bytes-per-sample))
+                  (make-audio-player audio-state-cb on-eof-stream-cb)
-                 (duration (hash-ref buf-info 'duration))
+                  (make-audio-player audio-state-cb on-eof-stream-cb
-                 )
+                                     #:remote-host player-host
-
+                                     #:replace-base-paths player-basepaths)))
-            (unless (stream-equal? rate bits-per-sample channels)
+        (audio-ao-buf-ms! player 500)
-              (dbg-rktplayer "Stream has changed to ~a ~a ~a" rate bits-per-sample channels)
+        (audio-buf-seconds! player buffer-min-seconds buffer-max-seconds)
-              (unless (eq? ao-handle #f)
-                (dbg-rktplayer "Waiting for play buffer to reach empty state")
-                (while (> (ao-bufsize-async ao-handle) 0)
-                       (sleep 0.25)
-                       )
-                (dbg-rktplayer "Closing ao-handle")
-                (ao-close ao-handle)
-                (set! ao-handle #f))
-              )
-            
-            (set! current-rate rate)
-            (set! current-bits bits-per-sample)
-            (set! current-channels channels)
-            (set! current-length duration)
-            
-            (when (eq? ao-handle #f)
-              (audio-info-cb sample current-rate current-channels current-bits current-audio-format)
-              )
-
-            (check-ao-handle)
-            (when (not (eq? ao-handle #f))
-              (let ((buf-seconds-left (λ () (exact->inexact
-                                             (/ (ao-bufsize-async ao-handle)
-                                                bytes-per-sample-all-channels
-                                                rate)))))
-                (when (> (buf-seconds-left) buffer-max-seconds)
-                  (while (and (not (eq? ao-handle #f))
-                              (not closing)
-                              (not pause)
-                              (> (buf-seconds-left) buffer-min-seconds))
-                         (sleep 0.25))))
-
-              (when (not (eq? ao-handle #f))
-                (ao-play ao-handle current-track-id second duration buffer buf-len ao-type)
-                )
-              )
-
-            (when pause
-              (dbg-rktplayer "Pausing now...")
-              (set-state! 'pauzed)
-              (ao-pause ao-handle #t)
-              (while (and (not (eq? ao-handle #f))
-                          (not closing)
-                          pause)
-                     (sleep 0.5))
-              (ao-pause ao-handle #f)
-              (dbg-rktplayer "Playing on...")
-              (set-state! 'playing)
-              )
-            )
-          )
-      )
-
-    (define (audio-meta type ao-type handle meta)
-      (set! current-audio-format type)
-      (dbg-rktplayer "type:    ~a" type)
-      (dbg-rktplayer "ao-type: ~a" ao-type)
-      (dbg-rktplayer "meta:    ~a" meta))
-
-    (define (play-track-worker)
-      (thread
-       (λ ()
-         (if (eq? ct-data #f)
-             'no-track-data
-             (let ((file (send ct-data get-file)))
-               (dbg-rktplayer "opening audios handle for file: ~a" file)
-               (set! audio-handle (audio-open file audio-meta audio-play))
-               (set! current-track-id (send ct-data get-id))
-               (dbg-rktplayer "Starting audio-read")
-               (audio-read audio-handle)
-               (unless (eq? state 'stopped)
-                 (set-state! 'track-feeded)
-                 (dbg-rktplayer "Audio read done")
-                 )
-               'worker-done
-               )
-             )
-         )
-       )
-      (set-state! 'playing)
-      'playing
-      )
-
-    (define (close-player*)
-      (dbg-rktplayer "Closing audio handle")
-
-      (set! closing #t)
-
-      (unless (eq? audio-handle #f)
-        (audio-stop audio-handle)
-        (set! audio-handle #f))
-      
-      (set! current-rate 0)
-      (set! current-channels 0)
-      (set! current-bits 0)
-      (set! ct-data #f)
-      
-      (unless (eq? ao-handle #f)
-        (let ((h ao-handle))
-          (dbg-rktplayer "closing ao-handle")
-          (set! ao-handle #f)
-          (dbg-rktplayer "ao-handle = ~a" h)
-          (ao-close h)
         ))
-      (dbg-rktplayer "close-player*: ao-handle = ~a" ao-handle)
-      (dbg-rktplayer "Waiting for updater to stop")
-      (while (eq? play-time-updater-state 'updating)
-             (dbg-rktplayer "close-player*: ao-handle = ~a" ao-handle)
-             (sleep 0.1))
-      (dbg-rktplayer "resetting tracks")
-      (set! track -1)
-      (set! current-track -1)
 
-      (set! closing #f)
+    (define/public (change-player kind #:host [host #f] #:basepaths [basepaths #f])
-      )
+      (let ((op player))
-    
+        (unless (eq? player #f)
-    (define (quit-player)
+          (set! player #f)
-      (close-player*)
+          (audio-quit! op)
-      (set-state! 'quitted)
+          ;(displayln "Player quit")
-      )
-
-    (define (stop-and-clear)
-      (set-state! 'stopped)
-      (close-player*)
-      )
-
-    (define/public (next-track)
-      (unless (eq? repeat-state 'repeat-one)
-        (set! track (+ track 1)))
-      
-      (when (eq? repeat-state 'repeat-all)
-        (when (>= track (send pl length))
-            (set! track 0)))
-      
-      (if (>= track (send pl length))
-          (begin
-            (set-state! 'stopped)
-            (track-nr-updater #f))
-          (begin
-            (set! ct-data (send pl track track))
-            (set-state! 'play)
-            ;(track-nr-updater track)
-            )
-          )
-      )
-
-    (define/public (play-track i)
-      (unless (= (send pl length) 0)
-        (dbg-rktplayer "play-track ~a" i)
-        (set! state 'stopped)
-        (close-player*)
-        (dbg-rktplayer "Player closed")
-        (set! track i)
-        (set! ct-data (send pl track i))
-        (set-state! 'play)
-        (dbg-rktplayer "Set state to 'play, updating to track ~a" track)
-        (track-nr-updater track)
-        (dbg-rktplayer "track-nr-updater called")
-        )
-      )
-
-    (define/public (stop)
-      (stop-and-clear)
-      )
-
-    (define/public (set-volume! percentage)
-      (set! volume percentage)
-      (send settings set! 'volume percentage)
-      (unless (eq? ao-handle #f)
-        (ao-set-volume! ao-handle volume))
           )
+        ;(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)
-      volume)
+      (check-player)
+      (audio-volume player))
+
+    (define/public (set-volume! percentage)
+      (check-player)
+      (audio-volume! player percentage))
+
+    (define/public (set-list! playlist*)
+      ;; if the player exists and is playing, stop it.
+      (unless (eq? player #f)
+        (audio-stop! player))
+      ;; Set the playlist to the new one. 
+      (set! playlist playlist*)
+      ;; reset music-id to -1, because the playlist has been reset.
+      (set! music-id -1)
+      ;; clear lru cache, because the playlist has been reset.
+      (clear-music-ids!)
+      )
+
+    (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 (>= nr 0) (< nr (send playlist length)))
+        (let ((track (send playlist track nr)))
+          (let ((id (audio-play! player (send track get-file))))
+            (register-music-id&track-nr id nr)))))
 
     (define/public (next)
-      (if (= (send pl length) 0)
+      (check-player)
-          #f
+      (if (= music-id -1)
-          (let ((idx track))
+          (warn-rktplayer "No music-id set (yet), so can't play anything next")
-            (set! idx (+ idx 1))
+          (let ((track-nr (music-id->track-nr music-id)))
-            (when (>= idx (send pl length))
+            (if (eq? track-nr #f)
-              (set! idx 0))
+                (error "Unexpected: no track-nr for given music-id")
-            (send this play-track idx))
+                (begin
-          ))
+                  (cond
+                    ((eq? repeat 'repeat-one) (play-track track-nr))
+                    ((eq? repeat 'repeat-all)
+                     (set! track-nr (+ track-nr 1))
+                     (when (>= track-nr (send playlist length))
+                       (set! track-nr 0))
+                     (play-track track-nr))
+                    (else
+                     (set! track-nr (+ track-nr 1))
+                     (if (>= track-nr (send playlist length))
+                         (stop)
+                         (play-track track-nr)))
+                    )
+                  )
+                )
+            )
+          )
+      )
 
     (define/public (previous)
-      (if (= (send pl length) 0)
+      (check-player)
-          #f
+      (if (= music-id -1)
-          (let ((idx track))
+          (warn-rktplayer "No music-id set (yet), so can't play anything previous")
-            (set! idx (- idx 1))
+          (let ((track-nr (music-id->track-nr music-id)))
-            (when (< idx 0)
+            (if (eq? track-nr #f)
-              (set! idx (- (send pl length) 1)))
+                (error "Unexpected: no track-nr for given music-id")
-            (send this play-track idx)
+                (begin
-            )))
+                  (cond
-
+                    ((eq? repeat 'repeat-one) (play-track track-nr))
-    (define/public (pause-unpause)
+                    ((eq? repeat 'repeat-all)
-      (set! pause (not pause))
+                     (set! track-nr (- track-nr 1))
-      (dbg-rktplayer "pauzed: ~a" pause)
+                     (when (< track-nr 0)
+                       (set! track-nr (- (send playlist length) 1)))
+                     (play-track track-nr))
+                    (else
+                     (set! track-nr (- track-nr 1))
+                     (when (< track-nr 0) (set! track-nr 0))
+                     (play-track track-nr))
+                    )
+                  )
+                )
+            )
+          )
       )
 
     (define/public (pause!)
-      (set! pause #t))
+      (check-player)
+      (audio-pause! player #t))
 
     (define/public (play!)
-      (set! pause #f))
+      (check-player)
+      (audio-pause! player #f))
 
-    (define/public (get-repeat)
+    (define/public (pause-unpause)
-      repeat-state)
+      (check-player)
+      (if (audio-paused? player)
+          (send this pause!)
+          (send this play!)))
         
-    (define/public (repeat! state)          ; no-repeat, repeat-all, repeat-one
+    (define/public (stop)
-      (set! repeat-state state)
+      (check-player)
-      (repeat-updater state)
+      (audio-stop! player))
-      )
 
     (define/public (seek percentage)
-      (ao-clear-async ao-handle)
+      (check-player)
-      (audio-seek audio-handle percentage))
+      (audio-seek! player percentage))
 
-    (define (state-machine)
+    (define/public (get-repeat)
-      (let ((st (orig-current-seconds))
+      (check-player)
-            (s (orig-current-seconds)))
+      repeat)
-        (define (worker)
-          (if (eq? state 'quit)
-              (begin
-                (quit-player)
-                'done)
-              (begin
-                (cond
-                  ((eq? state 'stopped)
-                   (sleep 0.1))
-                  ((eq? state 'play)
-                   (if (eq? pl #f)
-                       (set-state! 'stoppped)
-                       (play-track-worker)))
-                  ((eq? state 'playing)
-                   (sleep 0.1))
-                  ((eq? state 'track-feeded)
-                   (send this next-track))
-                  (else
-                   (sleep 0.1))
-                  )
-                ;(let ((ns (orig-current-seconds)))
-                ;  (when (> (- ns 5) s)
-                ;    (displayln (format "state-machine: ~a" (- ns st)))
-                ;    (set! s ns)))
-                (worker)
-                )
-              ))
-        (worker)))
 
-    (define/public (set-list! playlist)
+    (define/public (repeat! r)
-      (stop-and-clear)
+      (check-player)
-      (set! pl playlist)
+      (set! repeat r))
-      )
-  
-    (define/public (play playlist)
-      (send this set-list! playlist)
-      (send this play-track 0)
-      )
     
     (define/public (quit)
-      (set-state! 'quit)
+      (unless (eq? player #f)
-      (while (not (eq? state 'quitted))
+        (audio-quit! player)))
-             (sleep 0.1))
-      )
     
     (super-new)
 
     (begin
-      (thread (λ () (state-machine)))
+      (dbg-rktplayer "player% initialized")
       )
     )
   )

playlist.rkt

@@ -2,10 +2,11 @@
 
 (require racket/class
          "music-library.rkt"
-         racket-sound
+         racket-audio
          "utils.rkt"
          racket-sprintf
          keystore/class
+         racket/list
          )
 
 (provide track%
@@ -50,6 +51,14 @@
     (define/public (get-length) length)
     (define/public (get-id) my-id)
 
+    (define/public (booklet-file)
+      (let* ((dir (path-only file))
+             (booklet-file (build-path dir "booklet.pdf")))
+        booklet-file))
+    
+    (define/public (has-booklet?)
+        (file-exists? (send this booklet-file)))
+
     (define/public (track< t2)
       (if (string-ci<? album (send t2 get-album))
           #t
@@ -331,6 +340,42 @@
         (send this save-tab!))
       )
 
+    (define/public (move-track from-idx to-idx)
+      (let ((tr (list-ref tracks from-idx))
+            (idx 0))
+        (if (= from-idx to-idx)
+            #t
+            (begin
+              (when (< from-idx to-idx)
+                (set! to-idx (- to-idx 1)))
+              (let* ((l1 (if (= from-idx 0)
+                             '()
+                             (take tracks from-idx)))
+                     (l2 (drop tracks (+ from-idx 1)))
+                     (l (append l1 l2))
+                     )
+                (set! tracks (append
+                              (if (= to-idx 0) '() (take l to-idx))
+                              (list tr)
+                              (drop l to-idx)))
+                )
+              (send this save-tab!)
+              )
+            )
+        )
+      )
+
+    (define/public (drop-id track-id)
+      (let ((idx (send this index track-id)))
+        (let* ((l1 (if (= idx 0) '() (take tracks idx)))
+               (l2 (drop tracks (+ idx 1)))
+               (l (append l1 l2)))
+          (set! tracks l)
+          (send this save-tab!)
+          )
+        )
+      )
+
     (define/public (track i)
       (list-ref tracks i))
 

rktplayer.rkt

@@ -2,8 +2,10 @@
 
 (require racket/gui
          "gui.rkt"
+         "tray.rkt"
+         "translate.rkt"
          simple-ini/class
-         racket-sound
+         racket-audio
          racket-webview
          racket/runtime-path
          "utils.rkt"
@@ -15,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)
@@ -36,6 +42,19 @@
   )
 
 (define rktplayer-window #f)
+(define rktplayer-tray #f)
+
+(define (close-off)
+  (send rktplayer-tray close)
+  (send rktplayer-window close)
+  (exit)
+  )
+
+(define-syntax ignore
+  (syntax-rules ()
+    ((_ body)
+     #t)))
+  
 
 (define (run . no-exit)
   (let* ((ini (new ini% [file 'rktplayer]))
@@ -45,13 +64,54 @@
                        [file-getter my-file-getter]
                        ))
          )
-    (let ((window (new rktplayer% [wv-context context] [log-file log-file])))
+    (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]))
+           )
       (set! rktplayer-window window)
-      (when (and (not (null? no-exit))
+      (set! rktplayer-tray tray)
+      (ignore
+      (thread (λ ()
+                (sleep 5)
+                (let ((prg (string-append "let f_evt_info = window.rkt_event_info;\n"
+                                          "window.rkt_event_info = function(e, id, evt) {\n"
+                                          "  if (evt.dataTransfer) {\n"
+                                          "    for(const item of evt.dataTransfer.items) {\n"
+                                          "       if (item.kind == 'file') {\n"
+                                          "          console.log(item.getAsFile());\n"
+                                          "       }\n"
+                                          "    }\n"
+                                          "  }\n"
+                                          "  return f_evt_info(e, id, evt);\n"
+                                          "}; return 42;")))
+                       
+
+                       #|(js (let* ((f_evt_info window.rkt_event_info))
+                                 (send console log "Setting new window.rkt_event_info")
+                                 (set! window.rkt_event_info
+                                       (λ (e id evt)
+                                         (if evt.dataTransfer
+                                             (let* ((items evt.dataTransfer.items)
+                                                    (fitems (send items filter (λ (item)
+                                                                                (return (== item.kind "file")))))
+                                                    )
+                                               (send fitems forEach (λ (item)
+                                                                      (console.log item)))
+                                               )
+                                             42)
+                                         (return (f_evt_info e id evt))))
+                                 (return 42)))))|#
+                  (displayln prg)
+                  (displayln (send window call-js prg)))))
+      )
+      (when (or (null? no-exit)
                 (not (eq? (car no-exit) #t)))
         (webview-wait-for-quit)
+        (send rktplayer-tray close)
         (webview-exit)
-        (exit))
+        ;(exit)
+        )
       )
     )
   )

run.sh

@@ -0,0 +1,2 @@
+#!/bin/bash
+racket -e '(enter! "rktplayer.rkt") (run)'

settings.rkt

@@ -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)
+    )
+  )

translate.rkt

@@ -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))
+    ((_ id (l ts))
-     (add-tr s 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)
+(define (current-lang)
-  (if (eq? language 'en)
+  language
-      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 (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"))
+  )

tray.rkt

@@ -0,0 +1,79 @@
+#lang racket
+
+(require racket-webview
+         racket/runtime-path
+         "translate.rkt"
+         "utils.rkt"
+         )
+
+(provide rktplayer-tray%)
+
+(define-runtime-path rkt-gui-dir "gui")
+
+(define rktplayer-tray%
+  (class wv-tray%
+    (init-field [rktplayer-gui (error "Must be called with the GUI Window of RktPlayer")]
+                )
+
+    (define (adjust-menu)
+      (dbg-rktplayer "adjust menu called, window state = ~a" (send rktplayer-gui window-state))
+      (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))
+                          )
+                 )
+            )
+        (send this set-menu! mnu)
+        (send this connect-menu! 'm-hide-show (λ () (show-hide)))
+        (send this connect-menu! 'm-quit (λ () (quit)))
+        (send this connect-menu! 'm-pause-play (λ () (pause-play)))
+        ))
+
+    (define (quit)
+      (send rktplayer-gui quit))
+
+    (define (pause-play)
+      (send rktplayer-gui play-or-pause))
+    
+    (define (show-hide)
+      (send rktplayer-gui show-hide)
+      (adjust-menu)
+      )
+
+    (define/override (activated reason)
+      (show-hide)
+      #t)
+
+    (super-new [icon (build-path rkt-gui-dir "rktplayer.png")]
+               [tooltip (tr 'racket-music-player)])
+
+    (define last-state #f)
+
+    (begin
+      (send rktplayer-gui set-window-state-change-callback!
+            (λ ()
+              (let ((st (send rktplayer-gui window-state)))
+                (if (eq? st 'minimized)
+                    (begin
+                      (if (eq? last-state 'minimized)
+                          (begin
+                            (dbg-rktplayer "state = ~a, presenting window" st)
+                            (send rktplayer-gui present)
+                            (set! last-state 'presented))
+                          (begin
+                            (dbg-rktplayer "state = ~a, hiding window" st)
+                            (send rktplayer-gui hide)
+                            (set! last-state 'minimized))))
+                    (adjust-menu))
+                )
+              )
+            )
+      (adjust-menu)
+      )
+
+    )
+  )

utils.rkt

@@ -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))
+
+