-

gui.rkt

@@ -3,6 +3,7 @@
 (require web-racket
          racket/runtime-path
          racket/gui
+         racket-sprintf
          "utils.rkt"
          "music-library.rkt"
          "translate.rkt"
@@ -35,14 +36,70 @@
      [html-file rktplayer-start]
      )
 
+    (define closed #f)
     (define el-seeker #f)
     (define el-library #f)
     (define el-playlist #f)
+    (define el-at #f)
+    (define el-length #f)
     
     (define music-library (send settings get 'music-library (find-system-path 'home-dir)))
     (define current-music-path #f)
     (define playlist #f)
-    (define player (new player%))
+
+    (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)
+          (set! current-length-seconds ls)
+          (let ((as-str (sprintf "%02d:%02d:%02d"
+                                 (quotient as 3600)
+                                 (quotient (remainder as 3600) 60)
+                                 (remainder (remainder as 3600) 60)))
+                (ls-str (sprintf "%02d:%02d:%02d"
+                                 (quotient ls 3600)
+                                 (quotient (remainder ls 3600) 60)
+                                 (remainder (remainder ls 3600) 60)))
+                )
+            (unless closed
+              (send el-at set-inner-html! as-str)
+              (send el-length set-inner-html! ls-str)
+              (let ((seeker (exact->inexact (/ (* 100 as) ls))))
+                (displayln (format "seeker = ~a" seeker))
+                (send el-seeker set! (format "~a" seeker)))
+              )
+            )
+          )
+        )
+      )
+
+    (define current-track-nr #f)
+    (define (update-track-nr nr)
+      (let ((id (λ () (string->symbol (format "track-~a" (+ current-track-nr 1))))))
+        (unless (eq? current-track-nr #f)
+          (displayln (format "current track: ~a" (id)))
+          (let ((el (send this element (id))))
+            (send el remove-class! "current")))
+        
+        (set! current-track-nr nr)
+        
+        (unless (eq? current-track-nr #f)
+          (displayln (format "current track: ~a" (id)))
+          (let ((el (send this element (id))))
+            (send el add-class! "current")))
+        )
+      )
+    
+    (define player (new player%
+                        [time-updater update-time]
+                        [track-nr-updater update-track-nr]
+                        [settings settings]
+                        ))
     
     (define inner-html-handlers (make-hash))
 
@@ -61,6 +118,10 @@
         (send el-seeker on-change! seek-reactor))
 
       (set! el-library (send this element 'library))
+      (set! el-playlist (send this element 'tracks))
+
+      (set! el-at (send this element 'time))
+      (set! el-length (send this element 'totaltime))
 
       (send this set-menu! (player-menu))
       (send this connect-menu! 'm-quit (λ () (send this quit)))
@@ -71,7 +132,10 @@
 
 
     (define/public (update-playlist)
-      (displayln "Updating playlist")
+      (let ((html (send playlist to-html)))
+        (send el-playlist set-inner-html! html)
+        (update-track-nr current-track-nr)
+        )
       )
 
     (define/public (update-library)
@@ -103,8 +167,7 @@
                                                  (λ (args)
                                                    (send this path-choosen (cadr row))))
                                            (send el connect 'click
-                                                 (λ (args)
-                                                   (displayln args)))
+                                                 (λ (args) #t))
                                            (send el connect 'contextmenu
                                                  (λ (evt)
                                                    (send this context-for-path evt (cadr row))))
@@ -137,26 +200,24 @@
       )
 
     (define/public (context-for-path evt path)
-      (let* ((mnu (menu 'library-popup
-                   (menu-item 'm-play-this (tr "Play this") #:callback (λ () (send this play-path path)))
-                   (menu-item 'm-booklet (tr "Open booklet") #:callback (λ () (send this open-booklet path)))
-                   (menu-item 'm-folder  (tr "Open containing folder") #:callback (λ () (send this open-folder path))
-                              #:submenu
-                              (menu (menu-item 'm-idx (tr "Select Music Library Folder") #:separator #t)
-                                    (menu-item 'm-idy (tr "Quit") #:separator #t
-                                               #:submenu
-                                               (menu (menu-item 'mabd (tr "Ja"))
-                                                     (menu-item 'mdedjk (tr "No"))
-                                                     (menu-item 'sdakjfas (tr "akjfhalk"))
-                                                     ))
-                                      ))
-                   )
-                  )
-             (js-evt (hash-ref evt 'js_evt (make-hash)))
-             (clientX (hash-ref js-evt 'clientX 60))
-             (clientY (hash-ref js-evt 'clientY 60))
-            )
-        (send this popup-menu mnu clientX clientY)
+      (let ((items (list
+                    (menu-item 'm-play-this (tr "Play this") #:callback (λ () (send this play-path path))))))
+        (when (file-exists? path)
+          (set! items (append items
+                              (list
+                               (menu-item 'm-add-this (tr "Add this") #:callback (λ () (send this add-path path)))))))
+        (set! items (append items
+                            (list
+                             (menu-item 'm-booklet (tr "Open booklet") #:callback (λ () (send this open-booklet path))) ;; todo check if pdf file exists
+                             (menu-item 'm-folder  (tr "Open containing folder") #:callback (λ () (send this open-folder path)))
+                             )))
+        (let* ((mnu (menu 'library-popup items))
+               (js-evt (hash-ref evt 'js_evt (make-hash)))
+               (clientX (hash-ref js-evt 'clientX 60))
+               (clientY (hash-ref js-evt 'clientY 60))
+               )
+          (send this popup-menu mnu clientX clientY)
+          )
         )
       )
 
@@ -169,6 +230,11 @@
       (send player play playlist)
       )
 
+    (define/public (add-path path)
+      (send playlist add-track path)
+      (send this update-playlist)
+      )
+
     (define/public (open-booklet path)
       (displayln (format "Open booklet ~a" path)))
 
@@ -201,6 +267,8 @@
 
     (define/public (quit)
       (displayln (format "Quitting"))
+      (send player quit)
+      (set! closed #t)
       (send this close))
 
     (define/public (select-library)

gui/menu.js

@@ -0,0 +1,128 @@
+window._web_wire_popup_menu = function(menu, x = -1, y = -1, kind = 'popup') {
+    if (menu.id == '#f') { menu.id = null; }
+    let menu_id = (kind == 'popup') ? '@@popup-menu@@' : '@@menubar@@';
+    let submenu_els = [];
+    let triggerMenuItem;
+    let clearPopupMenu = function() {
+        if (kind == 'popup') {
+            let el = document.getElementById(menu_id);
+            if (el !== null) {
+                el.innerHTML = '';
+                el.style.display = 'none';
+            }
+            if (menu.id !== null) {
+                // Delay this trigger, because one could have choosen a menu item and we want this
+                // to be triggered before the clear command is send.
+                // But if no menu item has been selected, the clear command should
+                // eventually be send.
+                setTimeout(function () {
+                    console.log("Sending clear trigger for menu clearance : " + menu.id);
+                    let obj = { evt: 'menu-item-choosen', item: menu.id };
+                    window._web_wire_put_evt(obj);
+                }, 250);
+            }
+        } else {
+            // hide all submenus
+            submenu_els.forEach(function (el) { el.style.display = 'none'; });
+        }
+    };
+    triggerMenuItem = function(id) {
+        console.log("Triggering menu item : " + id);
+        let obj = { evt: 'menu-item-choosen', item: id };
+        window._web_wire_put_evt(obj);
+    };
+    let showSubMenu = function(menu_el, item_el, el, parent_type) {
+        if (parent_type == 'menu') {
+            el.style.display = 'flex';
+            let rect = item_el.getBoundingClientRect();
+            let r = rect.left;
+            let t = rect.height;
+            el.style.left = r + 'px';
+            el.style.top = t + 'px';
+        } else {
+            el.style.display = "flex";
+            let rect = menu_el.getBoundingClientRect();
+            let irect =item_el.getBoundingClientRect();
+            let r = rect.width + 5;
+            let t = irect.y - rect.y;
+            el.style.left =  r + "px";
+            el.style.top = t + "px";
+        }
+    };
+    let hideSubMenu = function(el) { el.style.display = "none"; };
+    let makePopupMenu = function(el, menu, visible, type) {
+        let i;
+        let N = menu.length;
+        for(i = 0; i < N; i++) {
+            let item = menu[i];
+            let item_el = document.createElement("div");
+            item_el.id = item.id;
+            item_el.classList.add("menu-item");
+            let item_el_icon = document.createElement('span');
+            item_el_icon.classList.add("menu-icon");
+            if (item.icon) {
+                let icon_img = document.createElement('img');
+                icon_img.setAttribute('src', item.icon);
+                item_el_icon.appendChild(icon_img);
+            }
+            if (item.separator) {
+                item_el.classList.add("separator");
+            }
+            let item_el_name = document.createElement('span');
+            item_el_name.classList.add('menu-name');
+            item_el_name.innerHTML = item.name;
+            let item_el_submenu = document.createElement('span');
+            item_el_submenu.classList.add('menu-submenu');
+            if (item.submenu) {
+                if (type == 'submenu' || kind == 'popup') {
+                    item_el_submenu.innerHTML = '&gt;';
+                }
+                item_el.setAttribute('type', 'submenu');
+                let submenu_el = document.createElement("div");
+                submenu_els.push(submenu_el);
+                submenu_el.classList.add("submenu");
+                submenu_el.classList.add("menu");
+                item_el.appendChild(submenu_el);
+                submenu_el.style.display = 'none';
+                makePopupMenu(submenu_el, item.submenu.menu, false, 'submenu');
+                item_el.addEventListener('mouseenter', function () { showSubMenu(el, item_el, submenu_el, type); });
+                item_el.addEventListener('mouseleave', function () { hideSubMenu(submenu_el); });
+            } else {
+                item_el.setAttribute('type', 'item');
+                item_el.addEventListener('click', function() { triggerMenuItem(item.id); });
+            }
+            item_el.appendChild(item_el_icon);
+            item_el.appendChild(item_el_name);
+            item_el.appendChild(item_el_submenu);
+            el.appendChild(item_el);
+        }
+    };
+    let el = document.getElementById(menu_id);
+    if (el === null) {
+        el = document.createElement("div");
+        el.id = menu_id;
+        el.classList.add((kind == 'popup') ? "popup-menu" : "menubar");
+        if (kind == 'popup') {
+            el.classList.add("menu");
+            document.body.appendChild(el);
+        } else {
+            document.body.prepend(el);
+        }
+    } else {
+        el.innerHTML = '';
+    }
+    makePopupMenu(el, menu.menu, true, 'menu');
+    el.style.left = x + "px";
+    el.style.top = y + "px";
+    el.style.display = "flex";
+    let clearer_f = function() {
+        clearPopupMenu();
+        document.body.removeEventListener('click', clearer_f);
+        document.body.removeEventListener('contextmenu', clearer_f);
+    };
+    document.body.addEventListener('click', clearer_f);
+    document.body.addEventListener('contextmenu', clearer_f);
+};
+window._web_wire_menu = function(menubar) {
+    window._web_wire_popup_menu(menubar, -1, -1, 'menubar');
+};

gui/rktplayer.html

@@ -4,7 +4,8 @@
 	<link rel="stylesheet" href="styles.css" />
 	<meta charset="UTF-8" />
 	<title>RktPlayer - A music player</title>
-	<script src="../../webui-wire/js/menu.js"></script>
+	<!--<script src="../../webui-wire/js/menu.js"></script>-->
+	<script src="menu.js"></script>
 </head>
 <body>
   <div class="pane">
@@ -13,8 +14,8 @@
 		<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" />
-		<div class="text-block"><span id="time" class="time">0:00</span></div>
-		<div class="text-block"><span id="totaltime" class="time">0:00</span></div>
+		<div class="text-block"><span id="time" class="time">00:00:00</span></div>
+		<div class="text-block"><span id="totaltime" class="time">00:00:00</span></div>
 		<button id="repeat" class="command"><img id="repeat-img" src="buttons/repeat-off.svg" /></button>
 		<button id="volume" class="command"><img id="volume-img" src="buttons/volume-high.svg" /></button>
 	</div>

gui/styles.css

@@ -55,13 +55,15 @@ input.h-slider {
 	display: flex;
 	justify-content: center;
 	align-items: center;
-	width: 4em;
+	/*width: 4em;*/
 	border-left: 1px solid black;
 }
 
-.buttons span.time {
+.buttons span.time, .buttons span.totaltime {
 	font-weight: bold;
 	text-align: center;
+	padding-left: 0.5em;
+	padding-right: 0.5em;
 }
 
 .hpane {
@@ -153,4 +155,21 @@ table.music-library tr:hover td {
 	text-wrap: nowrap;
 }
 
+table.tracks {
+	width: 94%;
+	margin-left: 3%;
+	margin-right: 3%;
+	margin-top: 5px;
+	margin-bottom: 5px;
+}
+
+table.tracks td.number {
+	text-align: right;
+}
+
+table.tracks tr.current {
+	font-weight: bold;
+	color: blue;
+}
+
        

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)
 

playlist.rkt

@@ -3,6 +3,8 @@
 (require racket/class
          "music-library.rkt"
          racket-sound
+         "utils.rkt"
+         racket-sprintf
          )
 
 (provide track%
@@ -65,7 +67,7 @@
       (and (<= (list-len tracks) max-tracks)
            (is-music-file? file)))
 
-    (define (add-track file)
+    (define (add-track* file)
       (let  ((track (new track% [file file])))
         (set! tracks (append tracks (list track)))))
 
@@ -83,7 +85,7 @@
                                   (if (directory-exists? p)
                                       (read-tracks-internal p)
                                       (when (and (file-exists? p) (can-add? p))
-                                        (add-track p)))))
+                                        (add-track* p)))))
                               content))
                   'no-file-or-dir
                   )
@@ -99,6 +101,9 @@
     (define/public (length)
       (list-len tracks))
 
+    (define/public (add-track file)
+      (add-track* file))
+
     (define/public (track i)
       (list-ref tracks i))
 
@@ -107,6 +112,32 @@
                   (send track displayln))
                 tracks))
 
+    (define/public (to-html)
+      (define (formatter row)
+        (let* ((track-idx (car row))
+               (track (track track-idx)))
+          (list
+           (list 'td (list (list 'class "number"))
+                 (format "~a." (send track get-number)))
+           (list 'td (list (list 'class "title"))
+                 (send track get-title))
+           (list 'td (list (list 'class "album"))
+                 (send track get-album))
+           (list 'td (list (list 'class "length"))
+                 (let* ((length-s (send track get-length))
+                        (hour (quotient length-s 3600))
+                        (min (quotient (remainder length-s 3600) 60))
+                        (sec (remainder (remainder length-s 3600) 60)))
+                   (sprintf "%02d:%02d:%02d" hour min sec)))
+           )))
+
+      (letrec ((f (λ (i N)
+                    (if (< i N)
+                        (cons (list (format "track-~a" (+ i 1)) i) (f (+ i 1) N))
+                        '()))))
+        (let ((rows (f 0 (send this length))))
+          (mktable rows 'tracks formatter))))
+
     (super-new)
     (begin
       (when (eq? start-map #f)

rktplayer.rkt

@@ -17,13 +17,15 @@
     )
   )
      
-(ww-set-debug #t)
+(ww-set-debug #f)
+(ww-set-log-level 'warning)
+;(ww-tail-log)
 ;(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 #f]))
+         (window (new rktplayer% [settings settings] [use-browser #t]))
          )
     window)
   )