-

player.rkt

@@ -13,6 +13,7 @@
   (class object%
     (init-field [settings #f]
                 [time-updater (λ (time-s length-s) #t)]
+                [track-nr-updater (λ (nr) #t)]
                 [buffer-max-seconds 10]
                 [buffer-min-seconds 4]
                 )
@@ -22,6 +23,7 @@
     (define track -1)
     (define current-track -1)
     (define ct-data #f)
+    (define closing #f)
     
     (define ao-handle #f)
     (define flac-handle #f)
@@ -33,52 +35,78 @@
     (define current-length 0)
     (define current-seconds 0)
 
+    (define play-time-updater-state 'stopped)
+
     (define (check-ao-handle)
-      (unless ao-handle
+      (when (eq? ao-handle #f)
         (unless (or (= current-rate 0) (= current-bits 0) (= current-channels 0))
+          (displayln (format "current-rate = ~a, current-bits = ~a, current-channels = ~a, ao-handle = ~a"
+                            current-rate current-bits current-channels ao-handle))
+          (displayln "Opening ao-handle")
           (let ((fmt (ao-mk-format current-bits current-rate current-channels 'big-endian)))
-            (set! ao-handle (ao-open-live #f fmt)))
+            (set! ao-handle (ao-open-live #f fmt))
+            (start-play-time-updater)
+            )
           )
         )
       )
 
-    (define (update-play-time)
-      (unless (eq? ao-handle #f)
-        (let ((seconds (ao-at-second ao-handle)))
-          (set! current-seconds seconds)
-          (time-updater current-seconds current-length)
-          )
+    (define (start-play-time-updater)
+      (when (eq? play-time-updater-state 'stopped)
+        (set! play-time-updater-state 'updating)
+        (displayln "Starting play-time-updater")
+        (thread (λ ()
+                  (define (updater)
+                    (if (eq? ao-handle #f)
+                        (begin
+                          (set! play-time-updater-state 'stopped)
+                          (displayln "Stopping play-time-updater")
+                          'done)
+                        (let ((seconds (ao-at-second ao-handle)))
+                          (set! current-seconds seconds)
+                          (time-updater current-seconds current-length)
+                          (sleep 0.1)
+                          (updater))))
+                  (updater)
+                  )
+                )
         )
       )
 
     (define (flac-play frame buffer)
-      (let* ((sample (hash-ref frame 'number))
-             (rate (hash-ref frame 'sample-rate))
-             (second (/ (* sample 1.0) (* rate 1.0)))
-             (bits-per-sample (hash-ref frame 'bits-per-sample))
-             (bytes-per-sample (/ bits-per-sample 8))
-             (channels (hash-ref frame 'channels))
-             (bytes-per-sample-all-channels (* channels bytes-per-sample))
-             (duration (hash-ref frame 'duration))
-             )
-        (set! current-rate rate)
-        (set! current-bits bits-per-sample)
-        (set! current-channels channels)
-        (set! current-length duration)
+        (unless (eq? state 'quitted)
+          (let* ((sample (hash-ref frame 'number))
+                 (rate (hash-ref frame 'sample-rate))
+                 (second (/ (* sample 1.0) (* rate 1.0)))
+                 (bits-per-sample (hash-ref frame 'bits-per-sample))
+                 (bytes-per-sample (/ bits-per-sample 8))
+                 (channels (hash-ref frame 'channels))
+                 (bytes-per-sample-all-channels (* channels bytes-per-sample))
+                 (duration (hash-ref frame 'duration))
+                 )
+            (set! current-rate rate)
+            (set! current-bits bits-per-sample)
+            (set! current-channels channels)
+            (set! current-length duration)
 
-        (check-ao-handle)
+            (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)
+                              (> (buf-seconds-left) buffer-min-seconds))
+                         (sleep 0.25))))
 
-        (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 (> (buf-seconds-left) buffer-min-seconds)
-                   (update-play-time)
-                   (sleep 0.25))))
-        
-        (ao-play ao-handle second buffer)
-        )
+              (when (not (eq? ao-handle #f))
+                (ao-play ao-handle second buffer)
+                )
+              )
+            )
+          )
       )
 
     (define (flac-meta meta)
@@ -90,9 +118,12 @@
          (if (eq? ct-data #f)
              'no-track-data
              (let ((file (send ct-data get-file)))
+               (displayln (format "opening flac handle for file: ~a" file))
                (set! flac-handle (flac-open file flac-meta flac-play))
+               (displayln "Starting flac-read")
                (flac-read flac-handle)
                (set! state 'track-feeded)
+               (displayln "Flac read stopped")
                'track-feeded
                )
              )
@@ -102,32 +133,83 @@
       'playing
       )
 
+    (define (close-player*)
+      (displayln "Closing flac handle")
+
+      (set! closing #t)
+
+      (unless (eq? flac-handle #f)
+        (flac-stop flac-handle)
+        (set! flac-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))
+          (displayln "closing ao-handle")
+          (set! ao-handle #f)
+          (ao-close h)
+          ))
+      (displayln (format "close-player*: ao-handle = ~a" ao-handle))
+      (displayln "Waiting for updater to stop")
+      (while (eq? play-time-updater-state 'updating)
+             (displayln (format "close-player*: ao-handle = ~a" ao-handle))
+             (sleep 0.1))
+      (displayln "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)
       (set! track (+ track 1))
       (if (>= track (send pl length))
-          (set! state 'stopped)
+          (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 (eq? flac-handle #f)
-        (flac-stop flac-handle))
+        (flac-stop flac-handle)
+        (set! flac-handle #f)
+        )
       (set! track i)
       (set! ct-data (send pl track i))
       (while (eq? state 'playing)
              (sleep 0.1))
-      (set! state 'play))
+      (set! state 'play)
+      (track-nr-updater i)
+      )
     
     (define (state-machine)
       (let ((st (orig-current-seconds))
             (s (orig-current-seconds)))
         (define (worker)
           (if (eq? state 'quit)
-              'done
+              (begin
+                (quit-player)
+                'done)
               (begin
                 (cond
                   ((eq? state 'stopped)
@@ -151,13 +233,16 @@
         (worker)))
   
     (define/public (play playlist)
-      (set! state 'stopped)
+      (stop-and-clear)
       (set! pl playlist)
       (send this play-track 0)
       )
 
     (define/public (quit)
-      (set! state 'quit))
+      (set! state 'quit)
+      (while (not (eq? state 'quitted))
+             (sleep 0.1))
+      )
 
     (super-new)