small adjustments, many enhancements to rktplayer

gui.rkt

@@ -4,6 +4,8 @@
          racket/runtime-path
          racket/gui
          racket-sprintf
+         open-app
+         xml
          "utils.rkt"
          "music-library.rkt"
          "translate.rkt"
@@ -24,27 +26,37 @@
     (wv-menu 'main-menu
           (wv-menu-item 'm-file (tr "File")
                      #:submenu
-                     (wv-menu (wv-menu-item 'm-select-library-dir (tr "Select Music Library Folder"))
-                           (wv-menu-item 'm-set-lang (tr "Set language"))
-                           (wv-menu-item 'm-quit (tr "Quit") #:separator #t)))
+                     (wv-menu
+                      (wv-menu-item 'm-add-tab (tr "Add Playlist"))
+                      (wv-menu-item 'm-select-library-dir (tr "Select Music Library Folder"))
+                      (wv-menu-item 'm-set-lang (tr "Set language"))
+                      (wv-menu-item 'm-quit (tr "Quit") #:separator #t)))
           )
     ))
 
 (define rktplayer%
   (class wv-window%
     (inherit-field settings icon)
+
     (super-new
      [html-path "rktplayer.html"]
      [title "Racket Music Player"]
      [icon (build-path rkt-gui-dir "rktplayer.png")]
      )
 
+    (define initialized (make-semaphore 0))
+    
     (define closed #f)
     (define el-seeker #f)
     (define el-library #f)
     (define el-playlist #f)
     (define el-at #f)
     (define el-length #f)
+    (define el-rate #f)
+    (define el-channels #f)
+    (define el-bits #f)
+
+    (define current-tab 0)
     
     (define music-library
       (let ((path (format "~a" (send settings get 'music-library (find-system-path 'home-dir)))))
@@ -123,7 +135,7 @@
                 (dbg-rktplayer "Setting album art")
                 (let ((el (send this element 'album-art)))
                   (let ((html (format "<img src=\"/get-image?~a&~a\" />"
-                                      (string-replace (format "~a" stored-file) "\\" "/")
+                                      (format "~a" stored-file)
                                       (current-milliseconds))))
                     (dbg-rktplayer "Html = ~a" html)
                     (send el set-innerHTML! html)
@@ -148,32 +160,163 @@
       )
     
     (define (update-state st)
+      (dbg-rktplayer "state: ~a" st)
       (unless (eq? st state)
         (dbg-rktplayer "Changing to state ~a" st)
         (unless (eq? state #f) ; Prevent setting src twice very fast 
           (if (eq? st 'playing)
-              (set-play-button "buttons/stop.svg")
+              (set-play-button "buttons/pause.svg")
               (set-play-button "buttons/play.svg")
               )
           )
         (set! state st)
         )
       )
+
+    (define/public (update-tabs)
+      (displayln (format "playlist = ~a" playlist))
+      (let* ((tabs (send playlist tab-count))
+             (html "")
+             (tab-el (send this element 'tabs))
+             (idx 0)
+             )
+        (while (< idx tabs)
+           (let ((tab-name (send playlist get-tab-name idx)))
+             (set! html (string-append
+                         html
+                         (xexpr->string
+                          (list 'span (list (list 'id (format "tab~a" idx))
+                                            '(class "tab"))
+                                tab-name))))
+             )
+           (set! idx (+ idx 1)))
+        
+        (send tab-el set-innerHTML! html)
+        
+        (send this bind! "#tabs > span" 'click
+              (λ (el evt data)
+                (let* ((tab-id (send el id))
+                       (tab-idx (string->number (substring (format "~a" tab-id) 3)))
+                       )
+                  (send this set-tab! tab-idx))))
+
+        (send this bind! "#tabs > span" 'contextmenu
+              (λ (el evt data)
+                (let* ((tab-id (send el id))
+                       (tab-idx (string->number (substring (format "~a" tab-id) 3)))
+                       )
+                  (send this tab-context data tab-id tab-idx))))
+
+        (let ((id (string->symbol (format "tab~a" current-tab))))
+          (let ((el (send this element id)))
+            (send el add-class! 'current))
+          )
+        )
+      )
+
+    (define/public (tab-context evt tab-id tab-idx)
+      (let ((items (list
+                    (wv-menu-item 'm-tab-rename (tr "Rename playlist") #:callback (λ () (send this rename-tab! tab-id tab-idx)))
+                    (wv-menu-item 'm-tab-drop (tr "Remove playlist") #:callback (λ () (send this drop-tab! tab-id tab-idx)))
+                    (wv-menu-item 'm-tab-add (tr "Add playlist") #:callback (λ () (send this add-tab)))
+                    )
+                   )
+            )
+        
+        (let* ((mnu (wv-menu 'tab-popup items))
+               (clientX (hash-ref evt 'clientX 60))
+               (clientY (hash-ref evt 'clientY 60))
+               )
+          (send this popup-menu! mnu clientX clientY)
+          )
+        )
+      )
+
+    (define/public (drop-tab! tab-id tab-idx)
+      (when (= current-tab tab-idx)
+        (send this stop))
+      (send playlist drop-tab! tab-idx)
+      (send this set-tab! 0)
+      )
+
+    (define/public (rename-tab! tab-id tab-idx)
+      (let* ((inp-id (string->symbol (format "tab-input~a" tab-idx)))
+             (tab-el-id (string->symbol (format "tab~a" tab-idx)))
+             (html (list 'input (list (list 'id (format "~a" inp-id))
+                                      (list 'name (format "~a" inp-id))
+                                      '(type "text")
+                                      (list 'value (send playlist get-tab-name tab-idx))
+                                      )))
+             (tab-el (send this element tab-el-id))
+             (unbind-events (λ ()
+                              (send this unbind! inp-id 'change)
+                              (send this unbind! inp-id 'blur)))
+            )
+        (send tab-el set-innerHTML! html)
+        (send this unbind! tab-el-id '(click contextmenu))
+        (send this bind! inp-id 'change
+              (λ (el evt data)
+                (let ((tab-name (hash-ref data 'value (send playlist get-tab-name tab-idx))))
+                  (send playlist set-tab-name! tab-idx tab-name)
+                  (unbind-events)
+                  (send this update-tabs))))
+        (send this bind! inp-id 'blur
+              (λ (el evt data)
+                (unbind-events)
+                (send this update-tabs)))
+        (let ((inp-el (send this element inp-id)))
+          (send inp-el focus!))
+        )
+      )
+
+    (define/public (set-tab! tab-idx)
+      (send this stop)
+      (set! current-tab tab-idx)
+      (send playlist load-tab tab-idx)
+      (send this update-tabs)
+      (send this update-playlist)
+      )
+
+    (define/public (add-tab)
+      (send playlist add-tab!)
+      (send this update-tabs))
+
+    (define (update-audio-info samples rate channels bits)
+      (send el-bits set-innerHTML! (format "~a ~a" bits (tr "bits")))
+      (send el-channels set-innerHTML! (format "~a ~a" channels (tr "channels")))
+      (send el-rate set-innerHTML! (format "~a Hz" rate))
+      )
+
+    (define (update-repeat state)
+      (let ((img (if (eq? state 'no-repeat)
+                     "buttons/repeat-off.svg"
+                     (if (eq? state 'repeat-one)
+                         "buttons/repeat-one.svg"
+                         "buttons/repeat.svg"))))
+        (let ((el (send this element 'repeat-img)))
+          (send el set-attr! (list 'src img)))
+        )
+      )
     
     (define player (new player%
                         [time-updater update-time]
                         [track-nr-updater update-track-nr]
                         [state-updater update-state]
+                        [repeat-updater update-repeat]
+                        [audio-info-cb update-audio-info]
                         [settings settings]
                         ))
     
     (define inner-html-handlers (make-hash))
 
     (define/override (page-loaded oke)
+      (semaphore-wait initialized)
+      (semaphore-post initialized)
+      
       (super page-loaded oke)
 
-      (ww-connect 'play play-or-stop)
-      (ww-connect 'pause pause)
+      (ww-connect 'play play-or-pause)
+      (ww-connect 'stop stop)
       (ww-connect 'prev previous-track)
       (ww-connect 'next next-track)
       (ww-connect 'repeat repeat)
@@ -190,11 +333,19 @@
       (set! el-at (send this element 'time))
       (set! el-length (send this element 'totaltime))
 
+      (set! el-rate (send this element 'rate))
+      (set! el-bits (send this element 'bits))
+      (set! el-channels (send this element 'channels))
+
       (send this set-menu! (player-menu))
       (send this connect-menu! 'm-quit (λ () (send this quit)))
       (send this connect-menu! 'm-select-library-dir (λ () (send this select-library)))
+      (send this connect-menu! 'm-add-tab (λ () (send this add-tab)))
 
+      (displayln (format "page-loaded, playlist = ~a" playlist))
+      (send this update-tabs)
       (send this update-library)
+      (send this update-playlist)
       )
 
 
@@ -284,9 +435,14 @@
           (set! items (append items
                               (list
                                (wv-menu-item 'm-add-this (tr "Add this") #:callback (λ () (send this add-path path)))))))
+        (when (file-exists? (build-path path "booklet.pdf"))
+          (set! items (append items
+                              (list
+                               (wv-menu-item 'm-booklet (tr "Open booklet") #:callback (λ () (send this open-booklet path))) ;; todo check if pdf file exists
+                               ))))
+                                    
         (set! items (append items
                             (list
-                             (wv-menu-item 'm-booklet (tr "Open booklet") #:callback (λ () (send this open-booklet path))) ;; todo check if pdf file exists
                              (wv-menu-item 'm-folder  (tr "Open containing folder") #:callback (λ () (send this open-folder path)))
                              )))
         (let* ((mnu (wv-menu 'library-popup items))
@@ -300,7 +456,7 @@
 
     (define/public (play-path path)
       (dbg-rktplayer "Playing ~a" path)
-      (let ((pl (new playlist% [start-map path])))
+      (let ((pl (new playlist% [start-map path] [settings (send settings clone 'playlists)] [id current-tab])))
         (set! current-track-nr #f)
         (send pl read-tracks)
         (set! playlist pl)
@@ -316,21 +472,32 @@
       )
 
     (define/public (open-booklet path)
-      (dbg-rktplayer "Open booklet ~a" path))
+      (let ((booklet (build-path path "booklet.pdf")))
+        (dbg-rktplayer "Open booklet ~a" path)
+        (open-app booklet)))
 
     (define/public (open-folder path)
       (dbg-rktplayer "path: ~a" path)
-      (let ((folder (if (file-exists? path) (path-only path) path)))
-        (open-file-manager folder)))
+      (open-file-manager path))
+      ;(let ((folder (if (file-exists? path) (path-only path) path)))
+      ;  (open-file-manager folder)))
 
-    (define/public (play-or-stop)
-      (if (eq? state 'playing)
-          (begin
-            (send player stop)
-            (update-time 0.0 0.0))
-          (send player play-track current-track-nr))
+    (define/public (play-or-pause)
+      (cond
+        ((eq? state 'playing)
+         (send player pause!))
+        ((eq? state 'pauzed)
+         (send player play!))
+        (else
+         (play-track 0))
+        )
       )
 
+    (define/public (stop)
+      (dbg-rktplayer "Stop")
+      (send player stop)
+      (update-track-nr #f))
+
     (define/public (play-track idx)
       (send player play-track idx))
 
@@ -346,7 +513,14 @@
       )
 
     (define/public (repeat)
-      (dbg-rktplayer "Repeat")
+      (let ((r (send player get-repeat)))
+        (let ((nr (cond
+                    ((eq? r 'no-repeat) 'repeat-all)
+                    ((eq? r 'repeat-all) 'repeat-one)
+                    (else 'no-repeat))))
+          (send player repeat! nr)
+          )
+        )
       )
 
     (define/public (volume)
@@ -355,6 +529,7 @@
 
     (define/public (seek-to percentage)
       (dbg-rktplayer "Seeking to percentage: ~a" percentage)
+      (send player seek percentage)
       )
 
     (define/public (quit)
@@ -381,9 +556,14 @@
       )
 
     (begin
+      (displayln "Initalizing gui")
       (dbg-rktplayer "ICON: ~a" (get-field icon this))
       (let ((lang (send settings get 'lang 'en)))
         (dbg-rktplayer "RktPlayer started, current language: ~a" lang))
+      (set! playlist (new playlist% [settings (send settings clone 'playlists)]))
+      (send player set-list! playlist)
+      (displayln (format "playlist = ~a" playlist))
+      (semaphore-post initialized)
       )
     )
   )