-

gui.rkt

@@ -50,9 +50,11 @@
     (define current-at-seconds 0)
     (define current-length-seconds 0)
 
+    
     (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)
@@ -67,15 +69,12 @@
                                  (remainder (remainder ls 3600) 60)))
                 )
             (unless closed
-              (displayln "Updating time widgets")
               (send el-at set-inner-html! as-str)
               (send el-length set-inner-html! ls-str)
               (let ((seeker (if (= ls 0)
                                 0.0
                                 (exact->inexact (/ (* 100 as) ls)))))
-                ;(displayln (format "seeker = ~a" seeker))
                 (send el-seeker set! (format "~a" seeker)))
-              (displayln "done")
               )
             )
           )
@@ -84,37 +83,44 @@
 
     (define current-track-nr #f)
     (define (update-track-nr nr)
-      (displayln (format "update-track-nr ~a" nr))
+      (unless (eq? playlist #f)
-      (let ((id (λ () (send playlist track-id current-track-nr))) ;string->symbol (format "track-~a" (+ current-track-nr 1)))))
+        (displayln (format "update-track-nr ~a" nr))
-            (ct current-track-nr))
+        (let ((id (λ () (send playlist track-id current-track-nr))) ;string->symbol (format "track-~a" (+ current-track-nr 1)))))
+              (ct current-track-nr))
 
-        (displayln "Removing current")
+          (displayln "Removing current")
-        (unless (eq? current-track-nr #f)
+          (unless (eq? current-track-nr #f)
-          (displayln (format "current old track: ~a" (id)))
+            (displayln (format "current old track: ~a" (id)))
-          (let ((el (send this element (id))))
+            (let ((el (send this element (id))))
-            (send el remove-class! "current")))
+              (send el remove-class! "current")))
         
-        (set! current-track-nr nr)
+          (set! current-track-nr nr)
 
-        (displayln "Adding current")
+          (displayln "Adding current")
-        (unless (eq? current-track-nr #f)
+          (unless (eq? current-track-nr #f)
-          (displayln (format "current new track: ~a" (id)))
+            (displayln (format "current new track: ~a" (id)))
-          (let ((el (send this element (id))))
+            (let ((el (send this element (id))))
-            (send el add-class! "current"))
+              (send el add-class! "current"))
 
-          (displayln "Getting cover image")
+            (displayln "Getting cover image")
-          (let* ((track (send playlist track current-track-nr))
+            (let* ((track (send playlist track current-track-nr))
-                 (img-file "/tmp/cover-image")
+                   (img-file (if (eq? (system-type 'os) 'windows)
-                 (stored-file (send track image->file img-file))
+                                 "c:/tmp/cover-image"
+                                 "/tmp/cover-image"))
+                   (stored-file (send track image->file img-file))
                  )
-            (unless (eq? stored-file #f)
+              (displayln (format "image mimetype: ~a" (send track image->mimetype)))
-              (let ((el (send this element 'album-art)))
+              (unless (eq? stored-file #f)
-                (let ((html (format "<img src=\"~a\" />" stored-file)))
+                (let ((el (send this element 'album-art)))
-                  (send el set-inner-html! html))))
+                  (when (eq? (system-type 'os) 'windows)
-                ;(send el set-attr! 'src stored-file))))
+                    (set! stored-file (string-append "/" stored-file)))
+                  (let ((html (format "<img src=\"~a?~a\" />" stored-file (current-milliseconds))))
+                    (send el set-inner-html! html))))
+              ;(send el set-attr! 'src stored-file))))
+              )
             )
+          (displayln" Done updating track")
           )
-        (displayln" Done updating track")
         )
       )
 
@@ -282,11 +288,14 @@
 
     (define/public (play-path path)
       (displayln (format "Playing ~a" path))
-      (set! playlist (new playlist% [start-map path]))
+      (let ((pl (new playlist% [start-map path])))
-      (send playlist read-tracks)
+        (set! current-track-nr #f)
-      (displayln (format "number of tracks: ~a" (send playlist length)))
+        (send pl read-tracks)
-      (send this update-playlist)
+        (set! playlist pl)
-      (send player play playlist)
+        (send this update-playlist)
+        (send player play pl)
+        (displayln (format "number of tracks: ~a" (send playlist length)))
+        )
       )
 
     (define/public (add-path path)

player.rkt

@@ -221,7 +221,7 @@
       (set! track i)
       (set! ct-data (send pl track i))
       (set-state! 'play)
-      (displayln "Set state to 'play")
+      (displayln (format "Set state to 'play, updating to track ~a" track))
       (track-nr-updater track)
       (displayln "track-nr-updater called")
       )
@@ -287,7 +287,9 @@
   
     (define/public (play playlist)
       (stop-and-clear)
+      ;(unless (eq? pl #f) (send pl display-tracks))
       (set! pl playlist)
+      ;(unless (eq? pl #f) (send pl display-tracks))
       (send this play-track 0)
       )
 

playlist.rkt

@@ -68,6 +68,12 @@
               )
             #f)))
 
+    (define/public (image->mimetype)
+      (let ((tags (read-tags)))
+        (if (tags-valid? tags)
+            (tags-picture->mimetype tags)
+            'no-mimetype)))
+
     (super-new)
     
     (begin

rktplayer.rkt

@@ -19,17 +19,17 @@
   )
      
 (ww-set-debug #f)
-(ww-set-log-level 'warning)
+(ww-set-log-level 'info)
 ;(ww-tail-log)
 ;(ww-tail-log)
-;(ao-set-async-mode! 'scheme)
+(ao-set-async-mode! 'scheme)
 ;(collect-garbage 'incremental)
-(ao-set-async-mode! 'ffi)
+;(ao-set-async-mode! 'ffi)
 
 (define (run)
   (let* ((ini (new ini% [file 'rktplayer]))
          (settings (new ww-simple-ini% [ini ini] [section 'player]))
-         (window (new rktplayer% [settings settings] [use-browser #f]))
+         (window (new rktplayer% [settings settings] [use-browser #t]))
          )
     window)
   )