diff --git a/gui.rkt b/gui.rkt
index 5c85ed5..3530e12 100644
--- a/gui.rkt
+++ b/gui.rkt
@@ -2,6 +2,10 @@
(require web-racket
racket/runtime-path
+ racket/gui
+ "utils.rkt"
+ "music-library.rkt"
+ "translate.rkt"
)
(provide
@@ -9,16 +13,18 @@
rktplayer%
)
-(define-runtime-path rktplayer-start "rktplayer.html")
+(define-runtime-path rktplayer-start "gui/rktplayer.html")
-(define-syntax ww-connect
- (syntax-rules (this)
- ((_ id method)
- (send (send this element id) connect 'click (λ (data) (send this method)))
- )
- )
- )
-
+(define player-menu
+ (λ ()
+ (menu 'main-menu
+ (menu-item 'm-file (tr "File")
+ #:submenu
+ (menu (menu-item 'm-select-library-dir (tr "Select Music Library Folder"))
+ (menu-item 'm-set-lang (tr "Set language"))
+ (menu-item 'm-quit (tr "Quit") #:separator #t)))
+ )
+ ))
(define rktplayer%
(class ww-webview%
@@ -27,15 +33,132 @@
[html-file rktplayer-start]
)
+ (define el-seeker #f)
+ (define el-library #f)
+
+ (define music-library (send settings get 'music-library (find-system-path 'home-dir)))
+ (define current-music-path #f)
+
+ (define inner-html-handlers (make-hash))
+
(define/override (html-loaded)
(super html-loaded)
(ww-connect 'play play)
(ww-connect 'prev previous-track)
(ww-connect 'next next-track)
-
+ (ww-connect 'repeat repeat)
+ (ww-connect 'volume volume)
+
+ (set! el-seeker (send this element 'seek))
+ (displayln (format "el-seeker: ~a" (send el-seeker get)))
+ (let ((seek-reactor (make-delayed-reactor 0.3 (λ (percentage) (send this seek-to percentage)))))
+ (send el-seeker on-change! seek-reactor))
+
+ (set! el-library (send this element 'library))
+
+ (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 update-library)
)
+ (define/public (update-library)
+ (when (eq? current-music-path #f)
+ (set! current-music-path music-library))
+ (let* ((nr 0)
+ (l (filter (λ (r) (music-lib-relevant? (cadr r)))
+ (map (λ (e)
+ (set! nr (+ nr 1))
+ (list (format "row-~a" nr) (build-path current-music-path e) (format "path-~a" nr)))
+ (directory-list current-music-path)))))
+ (displayln current-music-path)
+ (displayln music-library)
+ (unless (equal? (format "~a" current-music-path) (format "~a" music-library))
+ (set! l (cons (list "lib-up" "↰" "lib-up") l))
+ )
+ (let ((html (mktable l 'music-library library-formatter)))
+ (let ((handle (send el-library set-inner-html! html)))
+ (hash-set! inner-html-handlers handle
+ (λ (oke)
+ (when oke
+ (send this bind 'dblclick "td.library-entry")
+ (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
+ (λ (args)
+ (send this path-choosen (cadr row))))
+ (send el connect 'click
+ (λ (args)
+ (displayln args)))
+ (send el connect 'contextmenu
+ (λ (evt)
+ (send this context-for-path evt (cadr row))))
+ )))
+ l)
+ ))))
+ ))
+ )
+
+ (define/override (inner-html-set handle oke)
+ (ww-debug "inner-html-set called")
+ (let ((cb (hash-ref inner-html-handlers handle #f)))
+ (ww-debug (format "got cb = ~a for handle ~a" cb handle))
+ (when cb
+ (hash-remove! inner-html-handlers handle)
+ (cb oke)))
+ )
+
+ (define/public (path-choosen path)
+ (let ((path-part (if (equal? path "↰") ".." (format "~a" path))))
+ (let ((npath (if (string=? path-part "..")
+ (build-path current-music-path path-part)
+ path)))
+ (when (directory-exists? npath)
+ (set! current-music-path (normalize-path npath))
+ (send this update-library)
+ )
+ )
+ )
+ )
+
+ (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)
+ )
+ )
+
+ (define/public (play-path path)
+ (displayln (format "Playing ~a" path)))
+
+ (define/public (open-booklet path)
+ (displayln (format "Open booklet ~a" path)))
+
+ (define/public (open-folder path)
+ (displayln (format "open folder ~a" path)))
+
(define/public (play)
(displayln "Play button clicked")
)
@@ -48,9 +171,42 @@
(displayln "Previous track")
)
+ (define/public (repeat)
+ (displayln "Repeat")
+ )
+
+ (define/public (volume)
+ (displayln "Volume")
+ )
+
+ (define/public (seek-to percentage)
+ (displayln (format "Seeking to percentage: ~a" percentage))
+ )
+
+ (define/public (quit)
+ (displayln (format "Quitting"))
+ (send this close))
+
+ (define/public (select-library)
+ (let ((handle (send this choose-dir
+ (tr "Choose the folder containing your music library")
+ (format "~a" music-library))))
+ (displayln (format "Selecting Music Library with handle: ~a" handle))
+ )
+ )
+
+ (define/override (dir-choosen handle choosen dir)
+ (when choosen
+ (set! music-library dir)
+ (send settings set! 'music-library dir)
+ (set! current-music-path #f)
+ (send this update-library)))
+
+
(begin
- (displayln "RktPlayer started")
- )
+ (let ((lang (send settings get 'lang 'en)))
+ (displayln (format "RktPlayer started, current language: ~a" lang)))
+ )
)
)
diff --git a/next.svg b/gui/buttons/next.svg
similarity index 100%
rename from next.svg
rename to gui/buttons/next.svg
diff --git a/play.svg b/gui/buttons/play.svg
similarity index 100%
rename from play.svg
rename to gui/buttons/play.svg
diff --git a/previous.svg b/gui/buttons/previous.svg
similarity index 100%
rename from previous.svg
rename to gui/buttons/previous.svg
diff --git a/repeat-off.svg b/gui/buttons/repeat-off.svg
similarity index 100%
rename from repeat-off.svg
rename to gui/buttons/repeat-off.svg
diff --git a/repeat-one.svg b/gui/buttons/repeat-one.svg
similarity index 100%
rename from repeat-one.svg
rename to gui/buttons/repeat-one.svg
diff --git a/repeat.svg b/gui/buttons/repeat.svg
similarity index 100%
rename from repeat.svg
rename to gui/buttons/repeat.svg
diff --git a/volume-high.svg b/gui/buttons/volume-high.svg
similarity index 100%
rename from volume-high.svg
rename to gui/buttons/volume-high.svg
diff --git a/volume-low.svg b/gui/buttons/volume-low.svg
similarity index 100%
rename from volume-low.svg
rename to gui/buttons/volume-low.svg
diff --git a/volume-mute.svg b/gui/buttons/volume-mute.svg
similarity index 100%
rename from volume-mute.svg
rename to gui/buttons/volume-mute.svg
diff --git a/gui/rktplayer.html b/gui/rktplayer.html
new file mode 100644
index 0000000..5270f53
--- /dev/null
+++ b/gui/rktplayer.html
@@ -0,0 +1,166 @@
+
+
+
+
+
+ RktPlayer - A music player
+
+
+
+
+
+
diff --git a/gui/styles.css b/gui/styles.css
new file mode 100644
index 0000000..68363c5
--- /dev/null
+++ b/gui/styles.css
@@ -0,0 +1,156 @@
+body {
+ font-family: Arial;
+ font-size: 11pt;
+}
+
+.pane {
+ height: calc(100vh - 40px - 2em - 10px);
+ width: calc(100% - 10px);
+ display: flex;
+ flex-direction: column;
+}
+
+.buttons {
+ height: 40px;
+ width: 100%;
+ display: flex;
+ justify-content: center;
+ align-items: center;
+ border: 1px solid black;
+ margin-bottom: 5px;
+}
+
+button {
+ background: #e0e0e0;
+ border: none;
+ border-left: 1px solid black;
+ border-right: 1px solid black;
+}
+
+button:hover {
+ background: #909090;
+}
+
+
+button.command {
+ margin: 0;
+ padding: 0;
+ width: 40px;
+ height: 40px;
+}
+
+button.command img {
+ height: 32px;
+ width: 32px;
+ margin: 0;
+ padding: 2px;
+}
+
+input.h-slider {
+ flex-grow: 1;
+}
+
+.buttons .text-block {
+ height: 100%;
+ display: flex;
+ justify-content: center;
+ align-items: center;
+ width: 4em;
+ border-left: 1px solid black;
+}
+
+.buttons span.time {
+ font-weight: bold;
+ text-align: center;
+}
+
+.hpane {
+ height: 100%;
+ width: 100%;
+ display: flex;
+}
+
+.music-info {
+ border: 1px solid black;
+ width: 30%;
+ height: 100%;
+}
+
+.music-library {
+ border-bottom: 1px solid black;
+ width: 100%;
+ height: 50%;
+}
+
+.album-art {
+ width: 100%;
+ height: 50%;
+ padding: 5px;
+}
+
+.music-playing {
+ border: 1px solid black;
+ border-left: none;
+ width: 70%;
+ height: 100%;
+}
+
+.content {
+ width: 100%;
+ height: 100%;
+ overflow: hidden;
+}
+
+.scrolly {
+ overflow-y: auto;
+}
+
+table.music-library {
+ padding: 5px;
+}
+
+table.music-library tr td {
+ border-bottom: 1px solid #f0f0f0;
+ cursor: default;
+ height: 1.1em;
+ width: 100%;
+ overflow: hidden;
+ text-overflow: ellipsis;
+ white-space: nowrap;
+ user-select: none;
+}
+
+table.music-library tr:hover td {
+ background: #e0e0e0;
+}
+
+.popup-menu, .popup-submenu {
+ display: flex;
+ flex-direction: column;
+ margin: 5px;
+ padding: 5px;
+ position: absolute;
+ z-index: 9999;
+ border: 1px solid black;
+ background: #e0e0e0;
+}
+
+.popup-submenu {
+ display: none;
+}
+
+.menubar .menu-item span.menu-icon, .popup-menu .menu-item span.menu-icon {
+ min-width: unset;
+ width: unset;
+}
+
+.menubar .menu-item {
+ min-width: unset;
+ width: unset;
+}
+
+.menu-item span.menu-name {
+ text-wrap: nowrap;
+}
+
+
diff --git a/music-library.rkt b/music-library.rkt
new file mode 100644
index 0000000..5ba4248
--- /dev/null
+++ b/music-library.rkt
@@ -0,0 +1,47 @@
+#lang racket
+
+(provide music-lib-relevant?
+ is-music-dir?
+ is-music-file?
+ basename
+ library-formatter
+ )
+
+(define (music-lib-relevant? f)
+ (let ((type (file-or-directory-type f #t)))
+ (if (eq? type 'directory)
+ (let ((name (basename f)))
+ (not (string-prefix? name ".")))
+ (if (eq? type 'file)
+ (let* ((fn (string-downcase (format "~a" f)))
+ (exts (list "flac" "mp3")))
+ (let ((l (filter (λ (e) (string-suffix? fn (string-append "." e))) exts)))
+ (not (null? l))))
+ #f))))
+
+(define (is-music-dir? f)
+ (and (music-lib-relevant? f)
+ (directory-exists? f)))
+
+(define (is-music-file? f)
+ (and (music-lib-relevant? f)
+ (file-exists? f)))
+
+(define (basename file)
+ (call-with-values (λ () (split-path file))
+ (λ (base name is-dir)
+ (path->string name))))
+
+(define (library-formatter row)
+ (let ((file-entry (car row))
+ (file-id (cadr row))
+ )
+ (list (list 'td (list (list 'class "library-entry") (list 'id file-id) (list 'file (format "~a" file-entry)))
+ (if (equal? file-id "lib-up")
+ file-entry
+ (basename file-entry))
+ ))
+ )
+ )
+
+
diff --git a/player.rkt b/player.rkt
new file mode 100644
index 0000000..6f1f7b4
--- /dev/null
+++ b/player.rkt
@@ -0,0 +1 @@
+#lang racket
diff --git a/playlist.rkt b/playlist.rkt
new file mode 100644
index 0000000..6f1f7b4
--- /dev/null
+++ b/playlist.rkt
@@ -0,0 +1 @@
+#lang racket
diff --git a/rktplayer.html b/rktplayer.html
deleted file mode 100644
index 147fc2a..0000000
--- a/rktplayer.html
+++ /dev/null
@@ -1,35 +0,0 @@
-
-
-
-
-
- RktPlayer - A music player
-
-
-
-
-
-
-
- Library
-
-
- Album art
-
-
-
- Music playing
-
-
-
-
-
diff --git a/rktplayer.rkt b/rktplayer.rkt
index 79af6e5..4ddb105 100644
--- a/rktplayer.rkt
+++ b/rktplayer.rkt
@@ -2,13 +2,21 @@
(require "gui.rkt"
simple-ini/class
+ web-racket
+ racket-sound
)
+
+(ww-set-custom-webui-wire-command! "/home/hans/src/racket/webui-wire/build/Release/webui-wire")
+(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]))
+ (window (new rktplayer% [settings settings] [use-browser #t]))
)
window)
)
+;(run)
\ No newline at end of file
diff --git a/styles.css b/styles.css
deleted file mode 100644
index 9ba29b9..0000000
--- a/styles.css
+++ /dev/null
@@ -1,66 +0,0 @@
-body {
- font-family: Arial;
- font-size: 11pt;
-}
-
-.pane {
- height: 100%;
- width: 100%;
- display: flex;
- flex-direction: column;
-}
-
-.buttons {
- height: 40px;
- width: 100%;
- display: flex;
- justify-content: center;
- align-items: center;
- border: 1px solid black;
-}
-
-button {
- background: #e0e0e0;
- border: none;
- border-left: 1px solid black;
- border-right: 1px solid black;
-}
-
-button:hover {
- background: #909090;
-}
-
-
-button.command {
- margin: 0;
- padding: 0;
- width: 40px;
- height: 40px;
-}
-
-button.command img {
- height: 32px;
- width: 32px;
- margin: 0;
- padding: 2px;
-}
-
-span.h-slider {
- flex-grow: 1;
-}
-
-.buttons .text-block {
- height: 100%;
- display: flex;
- justify-content: center;
- align-items: center;
- width: 4em;
- border-left: 1px solid black;
-}
-
-.buttons span.time {
- font-weight: bold;
- text-align: center;
-}
-
-
diff --git a/translate.rkt b/translate.rkt
new file mode 100644
index 0000000..e91b018
--- /dev/null
+++ b/translate.rkt
@@ -0,0 +1,53 @@
+#lang racket
+
+(provide tr)
+
+(define tr_map (make-hash))
+
+(define (add-tr sentence language translated-sentence)
+ (let ((lang-hash (hash-ref tr_map language (make-hash))))
+ (hash-set! lang-hash sentence translated-sentence)
+ (hash-set! tr_map language lang-hash)))
+
+(define-syntax add2
+ (syntax-rules ()
+ ((_ s (l ts))
+ (add-tr s l ts))))
+
+(define-syntax add
+ (syntax-rules ()
+ ((_ s l1 ...)
+ (begin
+ (add2 s l1)
+ ...))))
+
+
+(define language 'en)
+
+(define (languages)
+ '((en "English") (nl "Nederlands")))
+
+(define (set-lang! l)
+ (set! language l))
+
+(define (tr s)
+ (if (eq? language 'en)
+ s
+ (let ((lang-hash (hash-ref tr_map language (make-hash))))
+ (let ((translated (hash-ref lang-hash s (format "~a:~a" language s))))
+ translated
+ )
+ )
+ )
+ )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Translations
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(add "Select Music Library Folder"
+ ('nl "Selecteer map met Muziek Bibliotheek"))
+(add "Choose the folder containing your music library"
+ ('nl "Kies de map met de Muziek Bibliotheek"))
+(add "Quit"
+ ('nl "Beëindigen"))
diff --git a/utils.rkt b/utils.rkt
new file mode 100644
index 0000000..ea97986
--- /dev/null
+++ b/utils.rkt
@@ -0,0 +1,58 @@
+#lang racket/base
+
+(require racket/gui
+ xml
+ xml/xexpr
+ )
+
+(provide ww-connect
+ make-delayed-reactor
+ mktable
+ simple-row-formatter
+ )
+
+(define-syntax ww-connect
+ (syntax-rules (this)
+ ((_ id method)
+ (send (send this element id) connect 'click (λ (data) (send this method)))
+ )
+ )
+ )
+
+
+(define (make-delayed-reactor seconds closure)
+ (let* ((last-val #f)
+ (last-time -1)
+ (interval-ms (* seconds 1000))
+ (timeout-check (λ ()
+ (let ((ms (current-milliseconds)))
+ (unless (= last-time -1)
+ (when (> ms (+ last-time interval-ms))
+ (set! last-time -1)
+ (closure last-val))))))
+ (timer (new timer% [notify-callback timeout-check] [interval 100]))
+ )
+ (λ (val)
+ (set! last-val val)
+ (set! last-time (current-milliseconds))
+ )))
+
+
+(define (simple-row-formatter row)
+ (map (λ (e) (list 'td (format "~a" e))) row))
+
+(define (mktable l table-class row-formatter)
+ (xexpr->string
+ (append
+ (list 'table (list (list 'class (format "~a" table-class))))
+ (map (λ (row)
+ (let ((row-id (car row)))
+ (append (list 'tr (list (list 'id (format "~a" row-id))))
+ (row-formatter (cdr row)))))
+ l)
+ )
+ )
+ )
+
+
+