adjustment to the new audio-player module of racket-audio

gui.rkt

@@ -43,6 +43,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))
@@ -146,11 +147,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))))))
                     )))
               )
             )
@@ -170,17 +181,28 @@
           )
         )
       )
-    
+
     (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 
-          (if (eq? st 'playing)
-              (set-play-button "buttons/pause.svg")
-              (set-play-button "buttons/play.svg")
-              )
-          )
+        (let ((el (send this element 'paused)))
+          (cond ((or (eq? st 'playing) (eq? st 'play))
+                 (set-play-button "buttons/pause.svg")
+                 (send el set-innerHTML! '(span (tr "playing"))))
+                ((eq? st 'stopped)
+                 (set-play-button "buttons/play.svg")
+                 (send el set-innerHTML! '(span (tr "stopped"))))
+                ((eq? st 'paused)
+                 (set-play-button "buttons/play.svg")
+                 (send el set-innerHTML! '(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)
         )
       )
@@ -296,11 +318,14 @@
       (send playlist add-tab!)
       (send this update-tabs))
 
-    (define (update-audio-info samples rate channels bits audio-format)
-      (send el-bits set-innerHTML! (format "~a ~a" bits (tr "bits")))
-      (send el-channels set-innerHTML! (format "~a ~a" channels (tr "channels")))
-      (send el-rate set-innerHTML! (format "~a Hz" rate))
-      (send el-format set-innerHTML! (format "~a" audio-format))
+    (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)
@@ -384,14 +409,20 @@
       (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 +432,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)
@@ -510,9 +581,10 @@
       (send this update-playlist)
       )
 
-    (define/public (open-booklet path)
-      (let ((booklet (build-path path "booklet.pdf")))
-        (dbg-rktplayer "Open booklet ~a" path)
+    (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)
@@ -525,7 +597,7 @@
       (cond
         ((eq? state 'playing)
          (send player pause!))
-        ((eq? state 'pauzed)
+        ((eq? state 'paused)
          (send player play!))
         (else
          (play-track 0))
@@ -594,6 +666,7 @@
       (send player quit)
       (set! closed #t)
       (send this close)
+      (dbg-rktplayer "Calling super -> quit")
       (super quit)
       )
 
@@ -614,6 +687,27 @@
         )
       )
 
+    (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 "Initalizing gui")
       (dbg-rktplayer "ICON: ~a" (get-field icon this))
@@ -622,6 +716,7 @@
       (set! playlist (new playlist% [settings (send settings clone 'playlists)]))
       (send player set-list! playlist)
       (dbg-rktplayer "playlist = ~a" playlist)
+
       (semaphore-post initialized)
       )
     )

gui/rktplayer.html

@@ -49,8 +49,11 @@
 	        </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>
 			<div class="right">
 				<span class="info" id="volume-percentage"></span>
 				<span class="info" id="log-file"></span>

gui/styles.css

@@ -336,5 +336,20 @@ input.v-slider {
 }
 
 
+.blink {
+	animation: blink 3s infinite both;
+}
+
+@keyframes blink {
+  0%,
+  50%,
+  100% {
+    opacity: 1;
+  }
+  25%,
+  75% {
+    opacity: 0;
+  }
+}
 
        

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,187 @@
                 [buffer-max-seconds 10]
                 [buffer-min-seconds 4]
                 )
-    (define use-ao #t)
+
+    (define player       #f)
+    (define playlist     #f)
+    (define state        'stopped)
+    (define repeat       'no-repeat)
+
+    (define full-state   (make-hash))
+    (define music-id     -1)
+    (define track-cache (make-lru 10
+                                   #:cmp (λ (a b) (= (car a) (car b)))))
+
+
+    (define (music-id->track-nr id)
+      (let ((item (lru-use track-cache (list music-id) #f)))
+        (if (eq? item #f)
+            #f
+            (cadr item))))
+
+    (define (register-music-id&track-nr id track-nr)
+      (lru-add! track-cache (list id track-nr)))
+
+    (define (clear-music-ids!)
+      (lru-clear track-cache))
+
     
-    (define pl #f)
-    (define state 'stopped)
-    (define track -1)
-    (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 audio-handle #f)
-
-    (define current-music-id -1)
-    (define current-track-id -1)
-    
-    (define current-rate 0)
-    (define current-bits 0)
-    (define current-channels 0)
-    (define current-audio-format 'none)
-    
-    (define current-length 0)
-    (define current-seconds 0)
-
-    (define repeat 'no-repeat)   ;; no-repeat, repeat-1, repeat-all
-
-    (define play-time-updater-state 'stopped)
-
-    (define (set-state! st)
-      (set! state st)
-      (state-updater st))
-
-    (define (check-ao-handle)
-      (when (eq? ao-handle #f)
-        (unless (or (= current-rate 0) (= current-bits 0) (= current-channels 0))
-          (dbg-rktplayer "current-rate = ~a, current-bits = ~a, current-channels = ~a, ao-handle = ~a"
-                         current-rate current-bits current-channels ao-handle)
-          (dbg-rktplayer "Opening ao-handle")
-          (when use-ao
-            (set! ao-handle (ao-open-live current-bits current-rate current-channels 'native-endian))
-            (start-play-time-updater)
-            )
+    (define (audio-state-cb handle player-state st*)
+      (set! full-state st*)
+      (let ((st (audio-state player)))
+        (when (or (eq? st 'paused) (eq? st 'playing))
+          (time-updater (audio-at-second player)
+                        (audio-duration player))
+          (when (not (= music-id (audio-music-id player)))
+            (set! music-id (audio-music-id player))
+            (let ((track-nr (music-id->track-nr music-id)))
+              (if (eq? track-nr #f)
+                  (error "Unexpected: no track-nr for given music-id")
+                  (track-nr-updater track-nr))))
           )
-        )
-      (when (not (= (ao-volume ao-handle) volume))
-        (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)
+      (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)
-        (unless (eq? state 'quitted)
-          (let* ((sample (hash-ref buf-info 'sample))
-                 (rate (hash-ref buf-info 'sample-rate))
-                 (second (/ (* sample 1.0) (* rate 1.0)))
-                 (bits-per-sample (hash-ref buf-info 'bits-per-sample))
-                 (bytes-per-sample (/ bits-per-sample 8))
-                 (channels (hash-ref buf-info 'channels))
-                 (bytes-per-sample-all-channels (* channels bytes-per-sample))
-                 (duration (hash-ref buf-info 'duration))
-                 )
-
-            (unless (stream-equal? rate bits-per-sample channels)
-              (dbg-rktplayer "Stream has changed to ~a ~a ~a" rate bits-per-sample channels)
-              (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 (quit-player)
-      (close-player*)
-      (set-state! 'quitted)
-      )
-
-    (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))
-      )
+    (define (check-player)
+      (when (eq? player #f)
+        (set! player (make-audio-player audio-state-cb on-eof-stream-cb))
+        (audio-ao-buf-ms! player 500)
+        (audio-buf-seconds! player buffer-min-seconds buffer-max-seconds)
+        ))
 
     (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 (play playlist*)
+      (check-player)
+      (set-list! 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)
-          #f
-          (let ((idx track))
-            (set! idx (+ idx 1))
-            (when (>= idx (send pl length))
-              (set! idx 0))
-            (send this play-track idx))
-          ))
+      (check-player)
+      (if (= music-id -1)
+          (warn-rktplayer "No music-id set (yet), so can't play anything next")
+          (let ((track-nr (music-id->track-nr music-id)))
+            (if (eq? track-nr #f)
+                (error "Unexpected: no track-nr for given music-id")
+                (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)
-          #f
-          (let ((idx track))
-            (set! idx (- idx 1))
-            (when (< idx 0)
-              (set! idx (- (send pl length) 1)))
-            (send this play-track idx)
-            )))
-
-    (define/public (pause-unpause)
-      (set! pause (not pause))
-      (dbg-rktplayer "pauzed: ~a" pause)
+      (check-player)
+      (if (= music-id -1)
+          (warn-rktplayer "No music-id set (yet), so can't play anything previous")
+          (let ((track-nr (music-id->track-nr music-id)))
+            (if (eq? track-nr #f)
+                (error "Unexpected: no track-nr for given music-id")
+                (begin
+                  (cond
+                    ((eq? repeat 'repeat-one) (play-track track-nr))
+                    ((eq? repeat 'repeat-all)
+                     (set! track-nr (- track-nr 1))
+                     (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)
-      repeat-state)
-
-    (define/public (repeat! state)          ; no-repeat, repeat-all, repeat-one
-      (set! repeat-state state)
-      (repeat-updater state)
-      )
+    (define/public (pause-unpause)
+      (check-player)
+      (if (audio-paused? player)
+          (send this pause!)
+          (send this play!)))
+        
+    (define/public (stop)
+      (check-player)
+      (audio-stop! player))
 
     (define/public (seek percentage)
-      (ao-clear-async ao-handle)
-      (audio-seek audio-handle percentage))
+      (check-player)
+      (audio-seek! player percentage))
+
+    (define/public (get-repeat)
+      (check-player)
+      repeat)
+
+    (define/public (repeat! r)
+      (check-player)
+      (set! repeat r))
     
-    (define (state-machine)
-      (let ((st (orig-current-seconds))
-            (s (orig-current-seconds)))
-        (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)
-      (stop-and-clear)
-      (set! pl playlist)
-      )
-  
-    (define/public (play playlist)
-      (send this set-list! playlist)
-      (send this play-track 0)
-      )
-
     (define/public (quit)
-      (set-state! 'quit)
-      (while (not (eq? state 'quitted))
-             (sleep 0.1))
-      )
-
+      (unless (eq? player #f)
+        (audio-quit! player)))
+    
     (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,9 @@
 
 (require racket/gui
          "gui.rkt"
+         "tray.rkt"
          simple-ini/class
-         racket-sound
+         racket-audio
          racket-webview
          racket/runtime-path
          "utils.rkt"
@@ -36,6 +37,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,11 +59,49 @@
                        [file-getter my-file-getter]
                        ))
          )
-    (let ((window (new rktplayer% [wv-context context] [log-file log-file])))
+    (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))
-                 (not (eq? (car no-exit) #t)))
+      (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))
       )

run.sh

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

tray.rkt

@@ -0,0 +1,71 @@
+#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")])
+
+    (begin
+      (send rktplayer-gui set-window-state-change-callback!
+            (λ ()
+              (let ((st (send rktplayer-gui window-state)))
+                (if (eq? st 'minimized)
+                    (begin
+                      (dbg-rktplayer "state = ~a, hiding window" st)
+                      (send rktplayer-gui present)
+                      (send rktplayer-gui hide))
+                    (adjust-menu))
+                )
+              )
+            )
+      (adjust-menu)
+      )
+
+    )
+  )