-

.gitignore

@@ -18,3 +18,4 @@ compiled/
 # Dependency tracking files
 *.dep
 
+/*.bak

gui.rkt

@@ -9,7 +9,7 @@
          "playlist.rkt"
          "player.rkt"
          )
-
+ 
 (provide
  (all-from-out web-racket)
  rktplayer%
@@ -204,9 +204,11 @@
       (send this close))
 
     (define/public (select-library)
+      ;(set! music-library "c:\\Users\\Hans")
       (let ((handle (send this choose-dir
                        (tr "Choose the folder containing your music library")
-                       (format "~a" music-library))))
+                       (if (string? music-library) music-library (path->string music-library))
+                       )))
         (displayln (format "Selecting Music Library with handle: ~a" handle))
         )
       )

player.rkt

@@ -1,48 +1,159 @@
 #lang racket
 
 (require racket/class
-         racket-audio
+         racket-sound
+         "utils.rkt"
          )
 
 (provide player%)
 
+(define orig-current-seconds current-seconds)
+
 (define player%
   (class object%
-    (init-field [settings #f])
+    (init-field [settings #f]
+                [time-updater (λ (time-s length-s) #t)]
+                [buffer-max-seconds 10]
+                [buffer-min-seconds 4]
+                )
 
     (define pl #f)
     (define state 'stopped)
-    (define track 0)
+    (define track -1)
+    (define current-track -1)
+    (define ct-data #f)
+    
+    (define ao-handle #f)
+    (define flac-handle #f)
+    
+    (define current-rate 0)
+    (define current-bits 0)
+    (define current-channels 0)
+    
+    (define current-length 0)
+    (define current-seconds 0)
 
-    (define (player)
+    (define (check-ao-handle)
-      
+      (unless ao-handle
-      (define (state-machine)
+        (unless (or (= current-rate 0) (= current-bits 0) (= current-channels 0))
-        (cond
+          (let ((fmt (ao-mk-format current-bits current-rate current-channels 'big-endian)))
-          ((eq? state 'quit)
+            (set! ao-handle (ao-open-live #f fmt)))
-           'done)
+          )
-          ((eq? state 'stopped)
-           (sleep 0.25)
-           (state-machine))
-          ((eq? state 'play)
-           (if (eq? pl #f)
-               (begin
-                 (set! state 'stopped)
-                 (state-machine))
-               (begin
-                 (play-
-           
         )
-      
-      (thread (λ ()
-                
-      
       )
 
+    (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 (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)
+
+        (check-ao-handle)
+
+        (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)
+        )
+      )
+
+    (define (flac-meta meta)
+      (displayln meta))
+
+    (define (play-track-worker)
+      (thread
+       (λ ()
+         (if (eq? ct-data #f)
+             'no-track-data
+             (let ((file (send ct-data get-file)))
+               (set! flac-handle (flac-open file flac-meta flac-play))
+               (flac-read flac-handle)
+               (set! state 'track-feeded)
+               'track-feeded
+               )
+             )
+         )
+       )
+      (set! state 'playing)
+      'playing
+      )
+
+    (define/public (next-track)
+      (set! track (+ track 1))
+      (if (>= track (send pl length))
+          (set! state 'stopped)
+          (begin
+            (set! ct-data (send pl track track))
+            (set! state 'play)
+            )
+          )
+      )
+
+    (define/public (play-track i)
+      (unless (eq? flac-handle #f)
+        (flac-stop flac-handle))
+      (set! track i)
+      (set! ct-data (send pl track i))
+      (while (eq? state 'playing)
+             (sleep 0.1))
+      (set! state 'play))
+    
+    (define (state-machine)
+      (let ((st (orig-current-seconds))
+            (s (orig-current-seconds)))
+        (define (worker)
+          (if (eq? state 'quit)
+              'done
+              (begin
+                (cond
+                  ((eq? state 'stopped)
+                   (sleep 0.01))
+                  ((eq? state 'play)
+                   (if (eq? pl #f)
+                       (set! state 'stoppped)
+                       (play-track-worker)))
+                  ((eq? state 'playing)
+                   (sleep 0.01))
+                  ((eq? state 'track-feeded)
+                   (send this next-track))
+                  )
+                (let ((ns (orig-current-seconds)))
+                  (when (> (- ns 5) s)
+                    (displayln (format "state-machine: ~a" (- ns st)))
+                    (set! s ns)))
+                (worker)
+                )
+              ))
+        (worker)))
+  
     (define/public (play playlist)
       (set! state 'stopped)
       (set! pl playlist)
-      (set! track 0)
+      (send this play-track 0)
-      (set! state 'play)
       )
 
     (define/public (quit)
@@ -51,6 +162,7 @@
     (super-new)
 
     (begin
-      (player))
+      (thread (λ () (state-machine)))
+      )
     )
   )

playlist.rkt

@@ -29,6 +29,13 @@
                              album
                              length)))
 
+    (define/public (get-file) file)
+    (define/public (get-title) title)
+    (define/public (get-artist) artist)
+    (define/public (get-album) album)
+    (define/public (get-number) number)
+    (define/public (get-length) length)
+
     (super-new)
     (begin
       (unless (eq? file #f)

rktplayer.rkt

@@ -7,14 +7,23 @@
          )
 
 
-(ww-set-custom-webui-wire-command! "/home/hans/src/racket/webui-wire/build/Release/webui-wire")
+(let ((os (system-type 'os)))
+  (cond
+    ((eq? os 'windows)
+     (ww-set-custom-webui-wire-command! "C:/devel/racket/webui-wire/build/Release/webui-wire.exe"))
+    ((eq? os 'unix)
+     (ww-set-custom-webui-wire-command! "/home/hans/src/racket/webui-wire/build/Release/webui-wire"))
+    (else (error "Cannot set custom webui-wire command"))
+    )
+  )
+     
 (ww-set-debug #t)
 ;(ww-tail-log)
 
 (define (run)
   (let* ((ini (new ini% [file 'rktplayer]))
          (settings (new ww-simple-ini% [ini ini] [section 'player]))
-         (window (new rktplayer% [settings settings] [use-browser #t]))
+         (window (new rktplayer% [settings settings] [use-browser #f]))
          )
     window)
   )

utils.rkt

@@ -9,8 +9,24 @@
          make-delayed-reactor
          mktable
          simple-row-formatter
+         while
          )
 
+
+ (define-syntax while
+    (syntax-rules ()
+      ((_ cond body ...)
+       (letrec ((while-f (lambda (last-result)
+                           (if cond
+                               (let ((last-result (begin
+                                                    body
+                                                    ...)))
+                                 (while-f last-result))
+                               last-result))))
+         (while-f #f))
+       )
+      ))
+
 (define-syntax ww-connect 
   (syntax-rules (this)
     ((_ id method)