-

gui.rkt

@@ -67,11 +67,15 @@
                                  (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 (exact->inexact (/ (* 100 as) ls))))
+              (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")
               )
             )
           )
@@ -80,24 +84,54 @@
 
     (define current-track-nr #f)
     (define (update-track-nr nr)
-      (let ((id (λ () (string->symbol (format "track-~a" (+ current-track-nr 1))))))
+      (displayln (format "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))
+
+        (displayln "Removing current")
         (unless (eq? current-track-nr #f)
-          (displayln (format "current track: ~a" (id)))
+          (displayln (format "current old track: ~a" (id)))
           (let ((el (send this element (id))))
             (send el remove-class! "current")))
         
         (set! current-track-nr nr)
-        
+
+        (displayln "Adding current")
         (unless (eq? current-track-nr #f)
-          (displayln (format "current track: ~a" (id)))
+          (displayln (format "current new track: ~a" (id)))
           (let ((el (send this element (id))))
-            (send el add-class! "current")))
+            (send el add-class! "current"))
+
+          (displayln "Getting cover image")
+          (let* ((track (send playlist track current-track-nr))
+                 (img-file "/tmp/cover-image")
+                 (stored-file (send track image->file img-file))
+                 )
+            (unless (eq? stored-file #f)
+              (let ((el (send this element 'album-art)))
+                (let ((html (format "<img src=\"~a\" />" stored-file)))
+                  (send el set-inner-html! html))))
+                ;(send el set-attr! 'src stored-file))))
+            )
+          )
+        (displayln" Done updating track")
         )
       )
+
+    (define state #f)
+    (define (update-state st)
+      (unless (eq? st state)
+        (set! state st)
+        (if (eq? st 'playing)
+          (let ((btn (send this element 'play-img)))
+            (send btn set-attr! 'src "buttons/stop.svg"))
+          (let ((btn (send this element 'play-img)))
+            (send btn set-attr! 'src "buttons/play.svg")))))
     
     (define player (new player%
                         [time-updater update-time]
                         [track-nr-updater update-track-nr]
+                        [state-updater update-state]
                         [settings settings]
                         ))
     
@@ -106,7 +140,8 @@
     (define/override (html-loaded)
       (super html-loaded)
 
-      (ww-connect 'play play)
+      (ww-connect 'play play-or-stop)
+      (ww-connect 'pause pause)
       (ww-connect 'prev previous-track)
       (ww-connect 'next next-track)
       (ww-connect 'repeat repeat)
@@ -133,11 +168,37 @@
 
     (define/public (update-playlist)
       (let ((html (send playlist to-html)))
-        (send el-playlist set-inner-html! html)
+        (hash-set! inner-html-handlers (send el-playlist set-inner-html! html)
+                   (λ (oke)
+                     (when oke
+                       (send this bind 'click "table.tracks tr")
+                       (send playlist for-each
+                             (λ (idx track)
+                               (let* ((track-id (send playlist track-id idx))
+                                      (el (send this new-element track-id)))
+                                 (send el connect 'click
+                                       (λ (args)
+                                         (send this play-track idx))))
+                               )
+                             )
+                       )
+                     )
+                   )
+        (displayln "Done.")
         (update-track-nr current-track-nr)
         )
       )
 
+    (define/public (scroll-top id)
+      (send this exec-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))
@@ -157,17 +218,15 @@
             (hash-set! inner-html-handlers handle
                        (λ (oke)
                          (when oke
-                           (send this bind 'dblclick "td.library-entry")
+                           (send this scroll-top 'library) 
                            (send this bind 'click "td.library-entry")
                            (send this bind 'contextmenu "td.library-entry")
                            (for-each (λ (row)
                                        (let ((path-id (string->symbol (caddr row))))
                                          (let ((el (send this new-element path-id)))
-                                           (send el connect 'dblclick
+                                           (send el connect 'click
                                                  (λ (args)
                                                    (send this path-choosen (cadr row))))
-                                           (send el connect 'click
-                                                 (λ (args) #t))
                                            (send el connect 'contextmenu
                                                  (λ (evt)
                                                    (send this context-for-path evt (cadr row))))
@@ -244,10 +303,20 @@
         (open-file-manager folder)))
         ;(shell-execute #f folder #f #f 'sw_show)))
 
-    (define/public (play)
+    (define/public (play-or-stop)
-      (displayln "Play button clicked")
+      (if (eq? state 'playing)
+          (begin
+            (send player stop)
+            (update-time 0.0 0.0))
+          (send player play-track current-track-nr))
       )
 
+    (define/public (play-track idx)
+      (send player play-track idx))
+
+    (define/public (pause)
+      (send player pause-unpause))
+
     (define/public (next-track)
       (send player next)
       )

gui/buttons/pause.svg

@@ -0,0 +1,5 @@
+<?xml version="1.0" encoding="utf-8"?><!-- Uploaded to: SVG Repo, www.svgrepo.com, Generator: SVG Repo Mixer Tools -->
+<svg width="800px" height="800px" viewBox="0 0 24 24" fill="none" xmlns="http://www.w3.org/2000/svg">
+<path fill-rule="evenodd" clip-rule="evenodd" d="M10 5C10 3.34315 8.65686 2 7 2H5C3.34315 2 2 3.34315 2 5V19C2 20.6569 3.34315 22 5 22H7C8.65686 22 10 20.6569 10 19V5ZM8 5C8 4.44772 7.55229 4 7 4H5C4.44772 4 4 4.44772 4 5V19C4 19.5523 4.44772 20 5 20H7C7.55229 20 8 19.5523 8 19V5Z" fill="#0F0F0F"/>
+<path fill-rule="evenodd" clip-rule="evenodd" d="M22 5C22 3.34315 20.6569 2 19 2H17C15.3431 2 14 3.34315 14 5V19C14 20.6569 15.3431 22 17 22H19C20.6569 22 22 20.6569 22 19V5ZM20 5C20 4.44772 19.5523 4 19 4H17C16.4477 4 16 4.44772 16 5V19C16 19.5523 16.4477 20 17 20H19C19.5523 20 20 19.5523 20 19V5Z" fill="#0F0F0F"/>
+</svg>

gui/buttons/stop.svg

@@ -0,0 +1,17 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!-- Uploaded to: SVG Repo, www.svgrepo.com, Generator: SVG Repo Mixer Tools -->
+<svg width="800px" height="800px" viewBox="0 0 28 28" version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:sketch="http://www.bohemiancoding.com/sketch/ns">
+    
+    <title>stop</title>
+    <desc>Created with Sketch Beta.</desc>
+    <defs>
+
+</defs>
+    <g id="Page-1" stroke="none" stroke-width="1" fill="none" fill-rule="evenodd" sketch:type="MSPage">
+        <g id="Icon-Set" sketch:type="MSLayerGroup" transform="translate(-518.000000, -569.000000)" fill="#000000">
+            <path d="M544,594 C544,594.553 543.553,595 543,595 L521,595 C520.447,595 520,594.553 520,594 L520,572 C520,571.448 520.447,571 521,571 L543,571 C543.553,571 544,571.448 544,572 L544,594 L544,594 Z M544,569 L520,569 C518.896,569 518,569.896 518,571 L518,595 C518,596.104 518.896,597 520,597 L544,597 C545.104,597 546,596.104 546,595 L546,571 C546,569.896 545.104,569 544,569 L544,569 Z" id="stop" sketch:type="MSShapeGroup">
+
+</path>
+        </g>
+    </g>
+</svg>

gui/rktplayer.html

@@ -11,6 +11,7 @@
   <div class="pane">
 	<div class="buttons">
 		<button id="prev" class="command"><img id="previous-img" src="buttons/previous.svg" /></button>
+		<button id="pause" class="command"><img id="pause-img" src="buttons/pause.svg" /></button>
 		<button id="play" class="command"><img id="play-img" src="buttons/play.svg" /></button>
 		<button id="next" class="command"><img id="next-img" src="buttons/next.svg" /></button>
         <input type="range" min="0" max="100" value="0" class="h-slider" id="seek" step="0.01" />
@@ -23,18 +24,18 @@
 	        <div class="music-info">
 		        <div class="music-library">
                     <div id="library" class="content scrolly">
-    			        Library
+    			        <!-- Library -->
                     </div>
 		        </div>
 		        <div class="album-art">
                     <div id="album-art" class="content">
-    			        Album art
+    			        <!-- Album art -->
                     </div>
 		        </div>
 	        </div>
             <div class="music-playing">
                <div id="tracks" class="content scrolly">
-                   Music playing
+                   <!-- Music playing -->
                </div>
 	        </div>
        </div>

gui/styles.css

@@ -1,6 +1,8 @@
 body {
 	font-family: Arial;
 	font-size: 11pt;
+	background: #202020;
+	color: #ffffff;
 }
 
 .pane {
@@ -16,15 +18,15 @@ body {
 	display: flex;
 	justify-content: center;
 	align-items: center;
-	border: 1px solid black;
+	border: 1px solid #505050;
     margin-bottom: 5px;
 }
 
 button {
 	background: #e0e0e0;
 	border: none;
-	border-left: 1px solid black;
+	border-left: 1px solid #505050;
-	border-right: 1px solid black;
+	border-right: 1px solid #505050;
 }
 
 button:hover {
@@ -56,7 +58,7 @@ input.h-slider {
 	justify-content: center;
 	align-items: center;
 	/*width: 4em;*/
-	border-left: 1px solid black;
+	border-left: 1px solid #505050;
 }
 
 .buttons span.time, .buttons span.totaltime {
@@ -73,13 +75,13 @@ input.h-slider {
 }
 
 .music-info {
-    border: 1px solid black;
+    border: 1px solid #505050;
     width: 30%;
     height: 100%;
 }
 
 .music-library {
-    border-bottom: 1px solid black;
+    border-bottom: 1px solid #505050;
     width: 100%;
     height: 50%;
 }
@@ -91,7 +93,7 @@ input.h-slider {
 }
 
 .music-playing {
-    border: 1px solid black;
+    border: 1px solid #505050;
     border-left: none;
     width: 70%;
     height: 100%;
@@ -124,6 +126,7 @@ table.music-library tr td {
 
 table.music-library tr:hover td {
    background: #e0e0e0;
+   color: black;
 }
 
 .popup-menu, .popup-submenu {
@@ -135,6 +138,7 @@ table.music-library tr:hover td {
 	z-index: 9999;
 	border: 1px solid black;
 	background: #e0e0e0;
+	color: black;
 }
 
 .popup-submenu {
@@ -149,6 +153,11 @@ table.music-library tr:hover td {
 .menubar .menu-item {
 	min-width: unset;
 	width: unset;
+	color: black;
+}
+
+input[type="range"] {
+	accent-color: #c97101;
 }
 
 .menu-item span.menu-name {
@@ -167,17 +176,35 @@ table.tracks td.number {
 	text-align: right;
 }
 
-table.tracks tr {
+table.tracks tr, table.tracks td {
 	cursor: default;
+	user-select: none;
 }
 
 table.tracks tr:hover {
    background: #e0e0e0;
+   color: black;
+}
+
+table.tracks tr:hover.current {
+	color: #955c12;
 }
 
 table.tracks tr.current {
 	font-weight: bold;
-	color: blue;
+	color: #f3961e;
+}
+
+.album-art .content img {
+	width: auto;
+	height: calc(100% - 20px);
+	aspect-ratio: 1 / 1;
+	margin: auto;
+}
+
+.album-art .content {
+	display: flex;
+	justify-content: center;
 }
 
        

player.rkt

@@ -14,6 +14,7 @@
     (init-field [settings #f]
                 [time-updater (λ (time-s length-s) #t)]
                 [track-nr-updater (λ (nr) #t)]
+                [state-updater (λ (state) #t)]
                 [buffer-max-seconds 10]
                 [buffer-min-seconds 4]
                 )
@@ -24,6 +25,7 @@
     (define current-track -1)
     (define ct-data #f)
     (define closing #f)
+    (define pause #f)
     
     (define ao-handle #f)
     (define flac-handle #f)
@@ -39,6 +41,10 @@
 
     (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))
@@ -62,11 +68,13 @@
                     (if (or (eq? ao-handle #f) closing)
                         (begin
                           (set! play-time-updater-state 'stopped)
-                          (displayln "Stopping play-time-updater")
+                          (displayln "Terminating play-time-updater")
                           'done)
-                        (let ((seconds (ao-at-second ao-handle)))
+                        (let ((seconds (ao-at-second ao-handle))
+                              (duration (ao-music-duration ao-handle))
+                              )
                           (set! current-seconds seconds)
-                          (time-updater current-seconds current-length)
+                          (time-updater current-seconds duration)
                           (sleep 0.1)
                           (updater))))
                   (updater)
@@ -100,13 +108,25 @@
                 (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 second buffer)
+                (ao-play ao-handle second duration buffer)
                 )
               )
+
+            (when pause
+              (displayln "Pauzing now...")
+              (ao-pause ao-handle #t)
+              (while (and (not (eq? ao-handle #f))
+                          (not closing)
+                          pause)
+                     (sleep 0.25))
+              (ao-pause ao-handle #f)
+              (displayln "Playing on...")
+              )
             )
           )
       )
@@ -125,14 +145,14 @@
                (displayln "Starting flac-read")
                (let ((result (flac-read flac-handle)))
                  (if (eq? result 'end-of-stream)
-                   (set! state 'track-feeded)
+                   (set-state! 'track-feeded)
                    (displayln "Flac read stopped")))
                'worker-done
                )
              )
          )
        )
-      (set! state 'playing)
+      (set-state! 'playing)
       'playing
       )
 
@@ -154,6 +174,7 @@
         (let ((h ao-handle))
           (displayln "closing ao-handle")
           (set! ao-handle #f)
+          (displayln (format "ao-handle = ~a" h))
           (ao-close h)
           ))
       (displayln (format "close-player*: ao-handle = ~a" ao-handle))
@@ -170,11 +191,11 @@
     
     (define (quit-player)
       (close-player*)
-      (set! state 'quitted)
+      (set-state! 'quitted)
       )
 
     (define (stop-and-clear)
-      (set! state 'stopped)
+      (set-state! 'stopped)
       (close-player*)
       )
 
@@ -182,11 +203,11 @@
       (set! track (+ track 1))
       (if (>= track (send pl length))
           (begin
-            (set! state 'stopped)
+            (set-state! 'stopped)
             (track-nr-updater #f))
           (begin
             (set! ct-data (send pl track track))
-            (set! state 'play)
+            (set-state! 'play)
             (track-nr-updater track)
             )
           )
@@ -194,24 +215,19 @@
 
     (define/public (play-track i)
       (displayln (format "play-track ~a" i))
-      ;(unless (eq? flac-handle #f)
-      ;  (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))
-      ;(unless (eq? ao-handle #f)
-      ;  (ao-clear-async ao-handle))
-      ;(set! state 'play)
-      ;(track-nr-updater i)
       (set! state 'stopped)
       (close-player*)
+      (displayln "Player closed")
       (set! track i)
       (set! ct-data (send pl track i))
-      (set! state 'play)
+      (set-state! 'play)
+      (displayln "Set state to 'play")
       (track-nr-updater track)
+      (displayln "track-nr-updater called")
+      )
+
+    (define/public (stop)
+      (stop-and-clear)
       )
 
     (define/public (next)
@@ -233,6 +249,11 @@
               (set! idx (- (send pl length) 1)))
             (send this play-track idx)
             )))
+
+    (define/public (pause-unpause)
+      (set! pause (not pause))
+      (displayln (format "pauzed: ~a" pause))
+      )
     
     (define (state-machine)
       (let ((st (orig-current-seconds))
@@ -248,17 +269,17 @@
                    (sleep 0.01))
                   ((eq? state 'play)
                    (if (eq? pl #f)
-                       (set! state 'stoppped)
+                       (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)))
+                ;(let ((ns (orig-current-seconds)))
-                  (when (> (- ns 5) s)
+                ;  (when (> (- ns 5) s)
-                    (displayln (format "state-machine: ~a" (- ns st)))
+                ;    (displayln (format "state-machine: ~a" (- ns st)))
-                    (set! s ns)))
+                ;    (set! s ns)))
                 (worker)
                 )
               ))
@@ -271,7 +292,7 @@
       )
 
     (define/public (quit)
-      (set! state 'quit)
+      (set-state! 'quit)
       (while (not (eq? state 'quitted))
              (sleep 0.1))
       )

playlist.rkt

@@ -38,19 +38,41 @@
     (define/public (get-number) number)
     (define/public (get-length) length)
 
-    (super-new)
+    (define (read-tags)
-    (begin
+      (let* ((f (if (path? file) (path->string file) file))
-      (unless (eq? file #f)
+             (tags (id3-tags f))
-        (let ((f (if (path? file) (path->string file) file)))
+             (tmpfile #f))
-          (let ((tags (id3-tags f))
+        (unless (tags-valid? tags)
-                (tmpfile #f))
+          (let ((nfile (make-temporary-file "rktplayer-~a" #:copy-from f)))
-            (unless (tags-valid? tags)
-              (the-displayln "Invalid, try to open a copy of this file")
-              (let ((nfile (make-temporary-file "rktplayer-~a" #:copy-from f)))
                 (set! tags (id3-tags nfile))
                 (set! tmpfile nfile)
-                )
+                ))
+        (unless (eq? tmpfile #f)
+          (delete-file tmpfile))
+        tags
+        )
+      )
+
+    (define/public (image->file to-file)
+      (let ((tags (read-tags)))
+        (if (tags-valid? tags)
+            (let ((ext (tags-picture->ext tags)))
+              (if (eq? ext #f)
+                  #f
+                  (let ((path (string-append to-file "." (symbol->string ext))))
+                    (if (tags-picture->file tags path)
+                        path
+                        #f)
+                    )
+                  )
               )
+            #f)))
+
+    (super-new)
+    
+    (begin
+      (unless (eq? file #f)
+        (let ((tags (read-tags)))
             (if (tags-valid? tags)
                 (begin
                   (set! title (tags-title tags))
@@ -67,9 +89,6 @@
                   (set! length -1)
                   )
                 )
-            (unless (eq? tmpfile #f)
-              (delete-file tmpfile))
-            )
           )
         )
       )
@@ -77,6 +96,7 @@
   )
 
 (define list-len length)
+(define orig-for-each for-each)
 
 (define playlist%
   (class object%
@@ -104,7 +124,7 @@
                 (add-track dir))
               (if (directory-exists? dir)
                   (let ((content (directory-list dir)))
-                    (for-each (λ (entry)
+                    (orig-for-each (λ (entry)
                                 (let ((p (build-path dir entry)))
                                   (if (directory-exists? p)
                                       (read-tracks-internal p)
@@ -133,10 +153,22 @@
       (list-ref tracks i))
 
     (define/public (display-tracks)
-      (for-each (λ (track)
+      (orig-for-each (λ (track)
                   (send track displayln))
                 tracks))
 
+    (define/public (for-each f)
+      (let ((idx 0))
+        (orig-for-each (λ (track)
+                    (f idx track)
+                    (set! idx (+ idx 1)))
+                       tracks)
+        )
+      )
+
+    (define/public (track-id i)
+      (string->symbol (format "track-~a" (+ i 1))))
+
     (define/public (to-html)
       (define (formatter row)
         (let* ((track-idx (car row))
@@ -158,7 +190,7 @@
 
       (letrec ((f (λ (i N)
                     (if (< i N)
-                        (cons (list (format "track-~a" (+ i 1)) i) (f (+ i 1) N))
+                        (cons (list (send this track-id i) i) (f (+ i 1) N))
                         '()))))
         (let ((rows (f 0 (send this length))))
           (mktable rows 'tracks formatter))))

rktplayer.rkt

@@ -1,6 +1,7 @@
 #lang racket
 
-(require "gui.rkt"
+(require racket/gui
+         "gui.rkt"
          simple-ini/class
          web-racket
          racket-sound
@@ -21,12 +22,14 @@
 (ww-set-log-level 'warning)
 ;(ww-tail-log)
 ;(ww-tail-log)
-(ao-set-async-mode! 'scheme)
+;(ao-set-async-mode! 'scheme)
+;(collect-garbage 'incremental)
+(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 #t]))
+         (window (new rktplayer% [settings settings] [use-browser #f]))
          )
     window)
   )