simple-log integration
This commit is contained in:
193
gui.rkt
193
gui.rkt
@@ -1,6 +1,6 @@
|
||||
#lang racket
|
||||
|
||||
(require web-racket
|
||||
(require racket-webview
|
||||
racket/runtime-path
|
||||
racket/gui
|
||||
racket-sprintf
|
||||
@@ -12,28 +12,31 @@
|
||||
)
|
||||
|
||||
(provide
|
||||
(all-from-out web-racket)
|
||||
(all-from-out racket-webview)
|
||||
rktplayer%
|
||||
)
|
||||
|
||||
(define-runtime-path rktplayer-start "gui/rktplayer.html")
|
||||
(define-runtime-path rkt-gui-dir "gui")
|
||||
|
||||
|
||||
(define player-menu
|
||||
(λ ()
|
||||
(menu 'main-menu
|
||||
(menu-item 'm-file (tr "File")
|
||||
(wv-menu 'main-menu
|
||||
(wv-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)))
|
||||
(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)))
|
||||
)
|
||||
))
|
||||
|
||||
(define rktplayer%
|
||||
(class ww-webview%
|
||||
(inherit-field settings)
|
||||
(class wv-window%
|
||||
(inherit-field settings icon)
|
||||
(super-new
|
||||
[html-file rktplayer-start]
|
||||
[html-path "rktplayer.html"]
|
||||
[title "Racket Music Player"]
|
||||
[icon (build-path rkt-gui-dir "rktplayer.png")]
|
||||
)
|
||||
|
||||
(define closed #f)
|
||||
@@ -69,8 +72,8 @@
|
||||
(remainder (remainder ls 3600) 60)))
|
||||
)
|
||||
(unless closed
|
||||
(send el-at set-inner-html! as-str)
|
||||
(send el-length set-inner-html! ls-str)
|
||||
(send el-at set-innerHTML! as-str)
|
||||
(send el-length set-innerHTML! ls-str)
|
||||
(let ((seeker (if (= ls 0)
|
||||
0.0
|
||||
(exact->inexact (/ (* 100 as) ls)))))
|
||||
@@ -82,44 +85,45 @@
|
||||
)
|
||||
|
||||
(define current-track-nr #f)
|
||||
|
||||
(define (update-track-nr nr)
|
||||
(unless (eq? playlist #f)
|
||||
(displayln (format "update-track-nr ~a" nr))
|
||||
(dbg-rktplayer "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")
|
||||
(dbg-rktplayer "Removing current")
|
||||
(unless (eq? current-track-nr #f)
|
||||
(displayln (format "current old track: ~a" (id)))
|
||||
(dbg-rktplayer (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")
|
||||
(dbg-rktplayer "Adding current")
|
||||
(unless (eq? current-track-nr #f)
|
||||
(displayln (format "current new track: ~a" (id)))
|
||||
(dbg-rktplayer "current new track: ~a" (id))
|
||||
(let ((el (send this element (id))))
|
||||
(send el add-class! "current"))
|
||||
|
||||
(displayln "Getting cover image")
|
||||
(dbg-rktplayer "Getting cover image")
|
||||
(let* ((track (send playlist track current-track-nr))
|
||||
(img-file (if (eq? (system-type 'os) 'windows)
|
||||
"c:/tmp/cover-image"
|
||||
"/tmp/cover-image"))
|
||||
(stored-file (send track image->file img-file))
|
||||
)
|
||||
(displayln (format "image mimetype: ~a" (send track image->mimetype)))
|
||||
(dbg-rktplayer "image mimetype: ~a" (send track image->mimetype))
|
||||
(unless (eq? stored-file #f)
|
||||
(let ((el (send this element 'album-art)))
|
||||
(when (eq? (system-type 'os) 'windows)
|
||||
(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-innerHTML! html))))
|
||||
;(send el set-attr! 'src stored-file))))
|
||||
)
|
||||
)
|
||||
(displayln" Done updating track")
|
||||
(dbg-rktplayer "Done updating track")
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -130,9 +134,9 @@
|
||||
(set! state st)
|
||||
(if (eq? st 'playing)
|
||||
(let ((btn (send this element 'play-img)))
|
||||
(send btn set-attr! 'src "buttons/stop.svg"))
|
||||
(send btn set-attr! '(src "buttons/stop.svg")))
|
||||
(let ((btn (send this element 'play-img)))
|
||||
(send btn set-attr! 'src "buttons/play.svg")))))
|
||||
(send btn set-attr! '(src "buttons/play.svg"))))))
|
||||
|
||||
(define player (new player%
|
||||
[time-updater update-time]
|
||||
@@ -143,8 +147,8 @@
|
||||
|
||||
(define inner-html-handlers (make-hash))
|
||||
|
||||
(define/override (html-loaded)
|
||||
(super html-loaded)
|
||||
(define/override (page-loaded oke)
|
||||
(super page-loaded oke)
|
||||
|
||||
(ww-connect 'play play-or-stop)
|
||||
(ww-connect 'pause pause)
|
||||
@@ -154,7 +158,7 @@
|
||||
(ww-connect 'volume volume)
|
||||
|
||||
(set! el-seeker (send this element 'seek))
|
||||
(displayln (format "el-seeker: ~a" (send el-seeker get)))
|
||||
(dbg-rktplayer "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))
|
||||
|
||||
@@ -173,36 +177,32 @@
|
||||
|
||||
|
||||
(define/public (update-playlist)
|
||||
(let ((html (send playlist to-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))))
|
||||
(let* ((html (send playlist to-html))
|
||||
(result (send el-playlist set-innerHTML! html))
|
||||
)
|
||||
(dbg-rktplayer "result: ~a" result)
|
||||
(send this bind! "table.tracks tr" 'click
|
||||
(λ (el evt data)
|
||||
(let* ((track-id (send el attr/symbol 'id))
|
||||
(idx (send playlist index track-id))
|
||||
)
|
||||
(send this play-track idx)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(displayln "Done.")
|
||||
(update-track-nr current-track-nr)
|
||||
)
|
||||
)
|
||||
|
||||
(define/public (scroll-top id)
|
||||
(send this exec-js
|
||||
(send this run-js
|
||||
(format
|
||||
(string-append "let el_id = '~a';"
|
||||
(string-append "{ let el_id = '~a';"
|
||||
" console.log('id = ' + el_id);"
|
||||
" let el = document.getElementById(el_id);"
|
||||
" console.log(el);"
|
||||
"el.scrollTop = 0;")
|
||||
" el.scrollTop = 0;"
|
||||
"}")
|
||||
id)))
|
||||
|
||||
(define/public (update-library)
|
||||
@@ -214,41 +214,32 @@
|
||||
(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
|
||||
(let ((result (send el-library set-innerHTML! html)))
|
||||
(dbg-rktplayer "set-innerHTML!: ~a" result)
|
||||
(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 'click
|
||||
(λ (args)
|
||||
(send this path-choosen (cadr row))))
|
||||
(send el connect 'contextmenu
|
||||
(λ (evt)
|
||||
(send this context-for-path evt (cadr row))))
|
||||
)))
|
||||
l)
|
||||
))))
|
||||
(dbg-rktplayer "Binding...")
|
||||
(send this bind! "td.library-entry" 'click
|
||||
(λ (el evt data)
|
||||
(dbg-rktplayer "~a ~a" evt data)
|
||||
(dbg-rktplayer "id:~a, file:~a" (send el attr 'id) (send el attr 'file))
|
||||
(let ((path (send el attr 'file)))
|
||||
(unless (eq? path #f)
|
||||
(send this path-choosen path)))))
|
||||
(send this bind! "td.library-entry" 'contextmenu
|
||||
(λ (el evt data)
|
||||
(dbg-rktplayer "~a ~a" evt data)
|
||||
(let ((path (send el attr 'file)))
|
||||
(unless (eq? path #f)
|
||||
(send this context-for-path data path)))
|
||||
))
|
||||
(dbg-rktplayer "Done...")
|
||||
|
||||
))
|
||||
)
|
||||
|
||||
(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)
|
||||
@@ -266,35 +257,34 @@
|
||||
|
||||
(define/public (context-for-path evt path)
|
||||
(let ((items (list
|
||||
(menu-item 'm-play-this (tr "Play this") #:callback (λ () (send this play-path path))))))
|
||||
(wv-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)))))))
|
||||
(wv-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)))
|
||||
(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 (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))
|
||||
(let* ((mnu (wv-menu 'library-popup items))
|
||||
(clientX (hash-ref evt 'clientX 60))
|
||||
(clientY (hash-ref evt 'clientY 60))
|
||||
)
|
||||
(send this popup-menu mnu clientX clientY)
|
||||
(send this popup-menu! mnu clientX clientY)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define/public (play-path path)
|
||||
(displayln (format "Playing ~a" path))
|
||||
(dbg-rktplayer "Playing ~a" path)
|
||||
(let ((pl (new playlist% [start-map path])))
|
||||
(set! current-track-nr #f)
|
||||
(send pl read-tracks)
|
||||
(set! playlist pl)
|
||||
(send this update-playlist)
|
||||
(send player play pl)
|
||||
(displayln (format "number of tracks: ~a" (send playlist length)))
|
||||
(dbg-rktplayer "number of tracks: ~a" (send playlist length))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -304,13 +294,12 @@
|
||||
)
|
||||
|
||||
(define/public (open-booklet path)
|
||||
(displayln (format "Open booklet ~a" path)))
|
||||
(dbg-rktplayer "Open booklet ~a" path))
|
||||
|
||||
(define/public (open-folder path)
|
||||
(displayln path)
|
||||
(dbg-rktplayer "path: ~a" path)
|
||||
(let ((folder (if (file-exists? path) (path-only path) path)))
|
||||
(open-file-manager folder)))
|
||||
;(shell-execute #f folder #f #f 'sw_show)))
|
||||
|
||||
(define/public (play-or-stop)
|
||||
(if (eq? state 'playing)
|
||||
@@ -335,44 +324,44 @@
|
||||
)
|
||||
|
||||
(define/public (repeat)
|
||||
(displayln "Repeat")
|
||||
(dbg-rktplayer "Repeat")
|
||||
)
|
||||
|
||||
(define/public (volume)
|
||||
(displayln "Volume")
|
||||
(dbg-rktplayer "Volume")
|
||||
)
|
||||
|
||||
(define/public (seek-to percentage)
|
||||
(displayln (format "Seeking to percentage: ~a" percentage))
|
||||
(dbg-rktplayer "Seeking to percentage: ~a" percentage)
|
||||
)
|
||||
|
||||
(define/public (quit)
|
||||
(displayln (format "Quitting"))
|
||||
(dbg-rktplayer "Quitting")
|
||||
(send player quit)
|
||||
(set! closed #t)
|
||||
(send this close))
|
||||
|
||||
(define/public (select-library)
|
||||
;(set! music-library "c:\\Users\\Hans")
|
||||
(let ((handle (send this choose-dir
|
||||
(let ((dir (send this choose-dir
|
||||
(tr "Choose the folder containing your music library")
|
||||
(if (string? music-library) music-library (path->string music-library))
|
||||
)))
|
||||
(displayln (format "Selecting Music Library with handle: ~a" handle))
|
||||
)
|
||||
)
|
||||
|
||||
(define/override (dir-choosen handle choosen dir)
|
||||
(when choosen
|
||||
(if (eq? dir 'showing)
|
||||
'done
|
||||
(unless (eq? dir #f)
|
||||
(set! music-library dir)
|
||||
(send settings set! 'music-library dir)
|
||||
(set! current-music-path #f)
|
||||
(send this update-library)))
|
||||
|
||||
(send this update-library)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(begin
|
||||
(dbg-rktplayer "ICON: ~a" (get-field icon this))
|
||||
(let ((lang (send settings get 'lang 'en)))
|
||||
(displayln (format "RktPlayer started, current language: ~a" lang)))
|
||||
(dbg-rktplayer "RktPlayer started, current language: ~a" lang))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
@@ -114,7 +114,7 @@ table.music-library {
|
||||
}
|
||||
|
||||
table.music-library tr td {
|
||||
border-bottom: 1px solid #f0f0f0;
|
||||
/*border-bottom: 1px solid #f0f0f0;*/
|
||||
cursor: default;
|
||||
height: 1.1em;
|
||||
width: 100%;
|
||||
@@ -166,14 +166,25 @@ input[type="range"] {
|
||||
|
||||
table.tracks {
|
||||
width: 94%;
|
||||
margin-left: 3%;
|
||||
margin-right: 3%;
|
||||
margin-top: 5px;
|
||||
margin-bottom: 5px;
|
||||
}
|
||||
|
||||
table.tracks td {
|
||||
text-overflow: ellipsis;
|
||||
white-space: nowrap;
|
||||
padding-left: 5px;
|
||||
}
|
||||
|
||||
table.tracks td.number {
|
||||
text-align: right;
|
||||
width: 40px;
|
||||
}
|
||||
|
||||
table.tracks td.length {
|
||||
width: 30px;
|
||||
}
|
||||
|
||||
table.tracks td.title, table.tracks td.album {
|
||||
width: calc(50% - 70px);
|
||||
}
|
||||
|
||||
table.tracks tr, table.tracks td {
|
||||
|
||||
@@ -33,10 +33,12 @@
|
||||
(path->string name))))
|
||||
|
||||
(define (library-formatter row)
|
||||
(let ((file-entry (car row))
|
||||
(file-id (cadr row))
|
||||
(let* ((file-entry (car row))
|
||||
(file-id (format "file-~a" (cadr row)))
|
||||
(the-file (if (equal? file-id "lib-up") ".." file-entry))
|
||||
)
|
||||
(list (list 'td (list (list 'class "library-entry") (list 'id file-id) (list 'file (format "~a" file-entry)))
|
||||
;(displayln row)
|
||||
(list (list 'td (list (list 'class "library-entry") (list 'id file-id) (list 'file (format "~a" the-file)))
|
||||
(if (equal? file-id "lib-up")
|
||||
file-entry
|
||||
(basename file-entry))
|
||||
|
||||
@@ -188,6 +188,9 @@
|
||||
(define/public (track-id i)
|
||||
(string->symbol (format "track-~a" (+ i 1))))
|
||||
|
||||
(define/public (index id)
|
||||
(- (string->number (substring (symbol->string id) 6)) 1))
|
||||
|
||||
(define/public (to-html)
|
||||
(define (formatter row)
|
||||
(let* ((track-idx (car row))
|
||||
|
||||
@@ -3,33 +3,37 @@
|
||||
(require racket/gui
|
||||
"gui.rkt"
|
||||
simple-ini/class
|
||||
web-racket
|
||||
racket-sound
|
||||
racket-webview
|
||||
racket/runtime-path
|
||||
"utils.rkt"
|
||||
)
|
||||
|
||||
|
||||
(let ((os (system-type 'os)))
|
||||
(cond
|
||||
((eq? os 'windows)
|
||||
(ww-set-custom-webui-wire-command! "C:/devel/racket/webui-wire/build/Release/webui-wire.exe"))
|
||||
((eq? os 'unix)
|
||||
(ww-set-custom-webui-wire-command! "/home/hans/src/racket/webui-wire/build/Release/webui-wire"))
|
||||
(else (error "Cannot set custom webui-wire command"))
|
||||
)
|
||||
)
|
||||
|
||||
(ww-set-debug #f)
|
||||
(ww-set-log-level 'info)
|
||||
;(ww-tail-log)
|
||||
;(ww-tail-log)
|
||||
;(ao-set-async-mode! 'scheme)
|
||||
;(collect-garbage 'incremental)
|
||||
(define-runtime-path rkt-gui-dir "gui")
|
||||
(ao-set-async-mode! 'ffi)
|
||||
|
||||
(define log-file (build-path (find-system-path 'home-dir) ".rktplayer.log"))
|
||||
(sl-log-to-file log-file)
|
||||
|
||||
(displayln (format "Logging to file ~a" log-file))
|
||||
|
||||
(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]))
|
||||
(context (new wv-context%
|
||||
[base-path rkt-gui-dir]
|
||||
[ini ini]
|
||||
[file-getter (webview-standard-file-getter rkt-gui-dir
|
||||
#:not-exist
|
||||
(λ (file base-path path)
|
||||
(dbg-rktplayer "FILE:~a, ~a, ~a" file base-path path)
|
||||
(if (string-prefix? file "/tmp/cover-image")
|
||||
(begin
|
||||
(dbg-rktplayer "RETURNING FILE")
|
||||
file)
|
||||
path))
|
||||
)]
|
||||
))
|
||||
(window (new rktplayer% [wv-context context]))
|
||||
)
|
||||
window)
|
||||
)
|
||||
|
||||
18
utils.rkt
18
utils.rkt
@@ -3,6 +3,7 @@
|
||||
(require racket/gui
|
||||
xml
|
||||
xml/xexpr
|
||||
simple-log
|
||||
)
|
||||
|
||||
(provide ww-connect
|
||||
@@ -11,9 +12,17 @@
|
||||
simple-row-formatter
|
||||
while
|
||||
open-file-manager
|
||||
dbg-rktplayer
|
||||
err-rktplayer
|
||||
info-rktplayer
|
||||
warn-rktplayer
|
||||
fatal-rktplayer
|
||||
(all-from-out simple-log)
|
||||
)
|
||||
|
||||
|
||||
(sl-def-log rktplayer)
|
||||
|
||||
(define-syntax while
|
||||
(syntax-rules ()
|
||||
((_ cond body ...)
|
||||
@@ -31,12 +40,15 @@
|
||||
(define-syntax ww-connect
|
||||
(syntax-rules (this)
|
||||
((_ id method)
|
||||
(send (send this element id) connect 'click (λ (data) (send this method)))
|
||||
(begin
|
||||
(send this bind! id 'click
|
||||
(λ (el evt data)
|
||||
(send this method)))
|
||||
(send this element id))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(define (make-delayed-reactor seconds closure)
|
||||
(let* ((last-val #f)
|
||||
(last-time -1)
|
||||
@@ -67,6 +79,8 @@
|
||||
(append (list 'tr (list (list 'id (format "~a" row-id))))
|
||||
(row-formatter (cdr row)))))
|
||||
l)
|
||||
; Add one empty tr
|
||||
(list (list 'tr (list (list 'class "unresponsive"))))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user