#lang racket (require racket-webview racket/runtime-path racket/gui racket-sprintf open-app xml "../misc/utils.rkt" "translate.rkt" "../play/playlist.rkt" "../play/playlist-gui.rkt" "../play/base/player.rkt" "../play/dlna-player.rkt" "settings.rkt" "../library/libraries-config.rkt" "../library/library-browser.rkt" "../library/library-factory.rkt" "../library/library-ref.rkt" "../library/base/media-resource.rkt" "../play/base/renderer.rkt" "../play/dlna.rkt" ) (provide (all-from-out racket-webview) rktplayer% ) (define-runtime-path rkt-gui-dir "html") (define (checked-title title checked?) (if checked? (format "✓ ~a" title) title)) (define (media-item-formatter row) (let ((item-id (car row)) (title (cadr row))) (list (list 'td (list (list 'class "library-entry") (list 'id (format "item-~a" item-id)) (list 'item-id item-id)) title)))) (define player-menu (λ (renderers libraries current-player-id current-library-id player-connector library-connector) (wv-menu 'main-menu (wv-menu-item 'm-file (tr 'file) #:submenu (wv-menu 'file-menu (wv-menu-item 'm-settings (tr 'settings)) (wv-menu-item 'm-quit (tr 'quit) #:separator #t) )) (wv-menu-item 'm-players (tr 'players) #:submenu (apply wv-menu (append (list 'dlna-menu (wv-menu-item 'm-play-local (checked-title (tr 'play-local) (eq? current-player-id 'm-play-local))) (wv-menu-item 'm-check-dlna (tr 'check-dlna))) (let ((rndr-idx 0)) (map (λ (r) (let* ((idx rndr-idx) (id (string->symbol (format "m-renderer-~a" idx)))) (set! rndr-idx (+ rndr-idx 1)) (player-connector id idx) (wv-menu-item id (checked-title (send r get-name) (eq? current-player-id id)) #:separator (= idx 0)))) renderers))))) (wv-menu-item 'm-libraries (tr 'libraries) #:submenu (apply wv-menu (cons 'libraries-menu (let ((library-idx 0)) (map (lambda (cfg) (let* ((idx library-idx) (id (string->symbol (format "m-library-~a" idx)))) (set! library-idx (+ library-idx 1)) (library-connector id idx) (wv-menu-item id (checked-title (send cfg get-name) (eq? current-library-id (send cfg get-id)))))) libraries))))) ))) (define application-title "Racket Music Player") (define rktplayer% (class wv-window% (init-field [log-file #f]) (inherit-field settings icon) (super-new [html-path "rktplayer.html"] [title application-title] [icon (build-path rkt-gui-dir "rktplayer.png")] [quit-on-close #f] ) (define initialized (make-semaphore 0)) (define closed #f) (define el-seeker #f) (define el-volume #f) (define el-vol-perc #f) (define el-library #f) (define el-playlist #f) (define playlist-gui #f) (define el-at #f) (define el-length #f) (define el-rate #f) (define el-format #f) (define el-source #f) (define el-channels #f) (define el-bits #f) (define el-message #f) (define cfg (send settings clone 'settings)) (define current-tab 0) (define library-factory (get-library-factory)) (define libraries-config (send library-factory get-libraries-config)) (define library-browser #f) (define library-items (make-hash)) ;; A browse request can finish after another library or container has ;; already been selected. Only the most recent request may update the GUI. (define library-update-request 0) (define playlist #f) (define current-at-seconds 0) (define current-length-seconds 0) (define/public (update-volume) (let ((el (send this element 'volume-percentage))) (let ((percentage (send player get-volume))) (send el set-innerHTML! (sprintf "%s %d%" (tr 'volume) percentage))) ) ) (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-innerHTML! as-str) (send el-length set-innerHTML! ls-str) (let ((seeker (if (= ls 0) 0.0 (exact->inexact (/ (* 100 as) ls))))) (send el-seeker set! (format "~a" seeker))) ) ) (send this update-volume) ) ) ) (define/public (message! msg #:clear [clear #f] #:error [error #f]) (when (eq? el-message #f) (set! el-message (send this element 'message))) (unless (eq? el-message #f) (send el-message set-innerHTML! (if error (list 'span '((class "blink error")) msg) msg)) (when clear (void (thread (λ () (sleep 10) (send this message! "" #:clear #f))))) )) (define/private (track-source track) (let* ((reference (send track get-music-library-factory-id)) (library (and (library-ref? reference) (send libraries-config get-library (library-ref-library-id reference))))) (and library (send library get-name)))) (define/private (update-track-source! track) (when el-source (if track (let* ((resource (send track get-resource)) (uri (send resource get-uri)) (source (or (track-source track) uri))) (send el-source set-innerHTML! (xexpr->string (list 'span (list (list 'title uri)) (format "~a: ~a" (tr 'source) source))))) (send el-source set-innerHTML! "")))) (define (cache-updated entry downloaded total) (when (and page-ready (not closed)) (let ((status (send entry get-cache-status))) (case status ((downloading) (send this message! (format (tr 'downloading-track) (send entry get-number) (if (and total (> total 0)) (inexact->exact (round (* 100 (/ downloaded total)))) 0)) #:clear #t)) ((available) (send this update-playlist) (send this message! (format (tr 'download-track-complete) (send entry get-number) #:clear #t))) ((failed) (send this update-playlist) (send this message! (format (tr 'download-track-failed) (send entry get-number)) #:clear #t)) )))) (define current-track-nr #f) (define/private (popup-current-booklet evt) (when (and playlist (exact-nonnegative-integer? current-track-nr) (< current-track-nr (send playlist length))) (let ((track (send playlist track current-track-nr))) (when (and track (send track has-booklet?)) (let ((menu (wv-menu 'image-menu (wv-menu-item 'm-booklet (tr 'open-booklet) #:callback (lambda () (send this open-booklet (send track booklet-file) #t))))) (client-x (hash-ref evt 'clientX 60)) (client-y (hash-ref evt 'clientY 60))) (send this popup-menu! menu client-x client-y)))))) (define (update-track-nr nr) (when (eq? nr #f) (update-track-source! #f)) (unless (or (eq? playlist #f) (= (send playlist length) 0)) (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)) (dbg-rktplayer "Removing current") (unless (eq? current-track-nr #f) (dbg-rktplayer (format "current old track: ~a" (id))) (let ((el (send this element (id)))) (send el remove-class! "current"))) (set! current-track-nr nr) (update-track-source! (and current-track-nr (send playlist track current-track-nr))) (dbg-rktplayer "Adding current") (unless (eq? current-track-nr #f) (dbg-rktplayer "current new track: ~a" (id)) (let ((el (send this element (id)))) (send el add-class! "current")) (dbg-rktplayer "Getting cover image") (let* ((track (send playlist track current-track-nr)) (img-file (build-path (find-system-path 'cache-dir) "rktplayer-cover-image")) (stored-file (send track image->file img-file)) ) (dbg-rktplayer "image mimetype: ~a" (send track image->mimetype)) (dbg-rktplayer "stored-file = ~a" stored-file) (unless (eq? stored-file #f) (dbg-rktplayer "Setting album art") (let ((el (send this element 'album-art))) (let ((html (format "" (format "~a" stored-file) (current-milliseconds)))) (dbg-rktplayer "Html = ~a" html) (send el set-innerHTML! html) ))) ) ) (dbg-rktplayer "Done updating track") ) ) ) (define state #f) (define current-play-image "buttons/play.svg") (define (set-play-button img) (unless (string=? current-play-image img) (set! current-play-image img) (let ((btn (send this element 'play-img))) (send btn set-attr! (list 'src img)) ) ) ) (define (update-state st) (unless (eq? st state) (dbg-rktplayer "Changing to state ~a" st) (let ((el (send this element 'paused))) (cond ((or (eq? st 'playing) (eq? st 'play)) (set-play-button "buttons/pause.svg") (send el set-innerHTML! (list 'span (tr 'playing)))) ((eq? st 'stopped) (set-play-button "buttons/play.svg") (send el set-innerHTML! (list 'span (tr 'stopped)))) ((eq? st 'paused) (set-play-button "buttons/play.svg") (send el set-innerHTML! (list 'span '((class "blink")) (tr 'paused)))) ((eq? st 'starting) (set-play-button "buttons/pause.svg") (send el set-innerHTML! (list 'span (tr 'starting)))) ((eq? st 'quit) (void)) (else (warn-rktplayer "Unkown state for update-state ~a" st) (send el set-innerHTML! (list 'span '((class "blink")) (format "~a: ~a" (tr 'unknown-state) st)))) )) (set! state st) ) ) (define/public (update-tabs) (dbg-rktplayer "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 (log-file! file) (set log-file file)) (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 rate channels bits audio-format) (let ((format-num (λ (x) (if (= x 0) "-" x))) (format-dec (λ (x) (if (eq? x 'none) "-" x)))) (send el-bits set-innerHTML! (format "~a ~a" (format-num bits) (tr 'bits))) (send el-channels set-innerHTML! (format "~a ~a" (format-num channels) (tr 'channels))) (send el-rate set-innerHTML! (format "~a Hz" (format-num rate))) (send el-format set-innerHTML! (format "~a" (format-dec audio-format))) ) ) (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 #f) (define active-player-id 'm-play-local) (define dlna-renderers '()) (define renderer-preferences (new renderer-preferences% [settings settings])) (define page-ready #f) (define/private (get-media-library library-cfg) (send library-factory get-library (send library-cfg get-id) (send library-cfg get-kind) (send library-cfg get-kind-version))) (define/private (update-library-title! [library-cfg #f]) (send this set-title! (if library-cfg (format "~a - ~a" application-title (send library-cfg get-name)) application-title))) (define/private (use-library! library-cfg) (let ((current-library (send libraries-config current-library))) (unless (and current-library (eq? (send current-library get-id) (send library-cfg get-id)) (send library-cfg is-current?)) (when current-library (send current-library set-current! #f)) (send library-cfg set-current! #t)) (set! library-browser (new library-browser% [media-library (get-media-library library-cfg)])) (update-library-title! library-cfg))) (define/private (initialize-library-browser!) (let ((current-library (send libraries-config current-library))) (if current-library (use-library! current-library) (begin (set! library-browser #f) (update-library-title!))))) (define/public (select-library-by-index library-idx) (let ((library-cfg (list-ref (send libraries-config libraries) library-idx))) (use-library! library-cfg) (send this update-main-menu) (send this update-library))) (define/public (update-main-menu) (let* ((libraries (send libraries-config libraries)) (current-library (send libraries-config current-library)) (current-library-id (and current-library (send current-library get-id))) (connections '()) (menu (player-menu dlna-renderers libraries active-player-id current-library-id (lambda (id idx) (set! connections (cons (lambda () (send this disconnect-menu! id) (send this connect-menu! id (lambda () (with-handlers ((exn:fail? (lambda (e) (warn-rktplayer "Could not select media renderer: ~a; context: ~s" (exn-message e) (continuation-mark-set->context (exn-continuation-marks e))) (send this message! (exn-message e) #:clear #t #:error #t)))) (send this play-to-dlna idx))))) connections))) (lambda (id idx) (set! connections (cons (lambda () (send this disconnect-menu! id) (send this connect-menu! id (lambda () (send this select-library-by-index idx)))) connections)))))) (send this set-menu! menu) (for-each (lambda (connect) (connect)) connections) (void))) (define/public (play-local) (unless (eq? player #f) (send player stop) (send player quit)) (set! 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] )) (set! active-player-id 'm-play-local) (unless (eq? playlist #f) (send player playlist! playlist)) ) (define/public (play-to-dlna renderer-idx) (let ((renderer (list-ref dlna-renderers renderer-idx))) (info-rktplayer "Selecting media renderer index=~a name=~a" renderer-idx (send renderer get-name)) (unless (eq? player #f) (send player stop) (send player quit)) (set! player (new dlna-player% [renderer renderer] [time-updater update-time] [track-nr-updater update-track-nr] [state-updater update-state] [error-updater (lambda (kind detail) (send this message! (case kind ((renderer-unreachable) (format (tr 'renderer-unreachable) detail)) ((renderer-command-failed) (format (tr 'renderer-command-failed) detail)) (else (format (tr 'playback-failed) detail))) #:clear #t #:error #t))] [repeat-updater update-repeat] [audio-info-cb update-audio-info] [settings settings])) (set! active-player-id (string->symbol (format "m-renderer-~a" renderer-idx))) (unless (eq? playlist #f) (send player playlist! playlist)) (when page-ready (send this update-main-menu)))) (define/public (dlna-query-busy) (send this message! (tr 'dlna-query-busy) #:clear #t)) (define/public (set-dlna-renderers! renderers) (set! dlna-renderers renderers) (send this message! (format (tr 'dlna-renderers-count) (length renderers)) #:clear #t) (send this update-main-menu) #t) (define/public (check-dlna) (check-dlna-players this renderer-preferences)) (define inner-html-handlers (make-hash)) (define/override (page-loaded oke) (semaphore-wait initialized) (semaphore-post initialized) (super page-loaded oke) (let ((el (send this element 'log-file))) (send el set-innerHTML! (format "~a" log-file))) (ww-connect 'play play-or-pause) (ww-connect 'stop stop) (ww-connect 'prev previous-track) (ww-connect 'next next-track) (ww-connect 'repeat repeat) (ww-connect 'volume volume) (ww-connect 'devtools devtools) (set! el-seeker (send this element 'seek)) (dbg-rktplayer "el-seeker: ~a" (send el-seeker get)) (let ((seek-reactor (webview-delayed-reactor 0.3 (λ (percentage) ;(displayln (format "el-seeker: ~a" percentage)) (send this seek-to percentage))))) (send el-seeker on-change! seek-reactor)) (set! el-volume (send this element 'volume-range)) (set! el-vol-perc (send this element 'volume-perc)) (dbg-rktplayer "el-volume: ~a" (send el-volume get)) (let ((volume-reactor (webview-delayed-reactor 1.0 (λ (volume-range) (send this set-volume! volume-range)) #:update (λ (val) (send el-vol-perc set-innerHTML! (sprintf "%d%" val)))))) (send el-volume on-change! volume-reactor)) (set! el-library (send this element 'library)) (set! el-playlist (send this element 'tracks)) (send this bind! 'album-art 'contextmenu (lambda (element event data) (popup-current-booklet data))) (set! playlist-gui (new playlist-gui% [window this] [element el-playlist] [play-track-callback (lambda (track-idx) (send this play-track track-idx))] [playlist-changed-callback (lambda () (send this update-playlist))])) (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)) (set! el-format (send this element 'format)) (set! el-source (send this element 'source)) (set! page-ready #t) (send this update-main-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-settings (λ () (send this settings-dlg))) (send this connect-menu! 'm-add-tab (λ () (send this add-tab))) (send this connect-menu! 'm-play-local (λ () (send this play-local) (send this update-main-menu))) (send this connect-menu! 'm-check-dlna (λ () (send this check-dlna))) (dbg-rktplayer "page-loaded, playlist = ~a" playlist) (send this update-tabs) (send this update-library) (send this update-playlist) (when (eq? state #f) (update-audio-info 0 0 0 'none) (update-state 'stopped)) ) (define/public (update-playlist) (send playlist-gui update! playlist current-track-nr) (send this update-volume) ) (define/public (scroll-top id) (send this run-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/private (render-library! browser items can-go-up?) (hash-clear! library-items) (let ((rows '())) (when browser (let ((item-nr 0)) (set! rows (map (lambda (item) (let ((item-id (format "media-item-~a" item-nr))) (set! item-nr (+ item-nr 1)) (hash-set! library-items item-id item) (list (format "row-~a" item-nr) item-id (send item get-title)))) items))) (when can-go-up? (set! rows (cons (list "lib-up" "lib-up" "↰") rows)))) (let ((html (mktable rows 'music-library media-item-formatter))) (let ((result (send el-library set-innerHTML! html))) (dbg-rktplayer "set-innerHTML!: ~a" result) (send this scroll-top 'library) (send this bind! "td.library-entry" 'click (lambda (el evt data) (let ((item-id (send el attr 'item-id))) (cond ((equal? item-id "lib-up") (send browser go-up!) (send this update-library)) ((hash-has-key? library-items item-id) (let ((container (send (hash-ref library-items item-id) get-container))) (when container (send browser open-container! container) (send this update-library)))))))) (send this bind! "td.library-entry" 'contextmenu (lambda (el evt data) (let ((item-id (send el attr 'item-id))) (when (hash-has-key? library-items item-id) (send this context-for-media-item data (hash-ref library-items item-id)))))))))) (define/private (library-update-current? request browser) (and (= request library-update-request) (eq? browser library-browser) page-ready (not closed))) (define/public (update-library) (set! library-update-request (+ library-update-request 1)) (let ((request library-update-request) (browser library-browser)) (hash-clear! library-items) (if browser (begin (send el-library set-innerHTML! (xexpr->string (list 'div '((class "library-loading")) (tr 'searching)))) (thread (lambda () (with-handlers ((exn:fail? (lambda (exception) (when (library-update-current? request browser) (warn-rktplayer "Could not browse music library: ~a" (exn-message exception)) (send this message! (format (tr 'library-browse-failed) (exn-message exception)) #:clear #t #:error #t) (render-library! browser '() #f))))) (let ((items (send browser get-items)) (can-go-up? (send browser can-go-up?))) (when (library-update-current? request browser) (render-library! browser items can-go-up?))))))) (render-library! #f '() #f))) (void)) (define/private (media-item-containing-folder item) (let ((track (send item get-track))) (if track (let* ((resource (send track get-resource)) (file (and resource (is-a? resource media-resource-file%) (send resource get-file)))) (and file (path-only file))) (let* ((container-id (send item get-id)) (media-library (send library-browser get-media-library))) (and (eq? (send media-library get-kind) 'filesystem) (send media-library resolve-path (cdr container-id))))))) (define/public (context-for-media-item evt item) (let* ((track (send item get-track)) (containing-folder (media-item-containing-folder item)) (items (list (wv-menu-item 'm-play-this (tr 'play-this) #:callback (lambda () (send this play-media-item item))) (wv-menu-item 'm-add-this (tr 'add-this) #:callback (lambda () (send this add-media-item item)))))) (when (and track (send track has-booklet?)) (set! items (append items (list (wv-menu-item 'm-booklet (tr 'open-booklet) #:callback (lambda () (send this open-booklet (send track booklet-file) #t))))))) (when containing-folder (set! items (append items (list (wv-menu-item 'm-folder (tr 'open-containing-folder) #:callback (lambda () (send this open-folder containing-folder))))))) (let ((menu (wv-menu 'library-popup items)) (client-x (hash-ref evt 'clientX 60)) (client-y (hash-ref evt 'clientY 60))) (send this popup-menu! menu client-x client-y)))) (define play-remote #f) (define/public (toggle-remote) (info-rktplayer "Toggling remote playing") (set! play-remote (not play-remote)) ;(displayln (format "player = ~a" player)) (if play-remote (send player change-player 'remote #:host "hans@mahler.thuis.local" #:basepaths '(("\\\\panderleou\\music" . "/muziek") ("//panderleou/music" . "/muziek") )) (send player change-player 'local)) (info-rktplayer "Playing remote: ~a" play-remote) ) (define/public (play-media-item item) (set! current-track-nr #f) (send playlist replace-with-media-item! item) (send this update-playlist) (send player play playlist) (dbg-rktplayer "number of tracks: ~a" (send playlist length))) (define/public (add-media-item item) (send playlist add-media-item item) (send this update-playlist)) (define/public (open-booklet path . is-file*) (let* ((is-file (if (null? is-file*) #f (eq? (car is-file*) #t))) (booklet (if is-file path (build-path path "booklet.pdf")))) (dbg-rktplayer "Open booklet ~a" booklet) (open-app booklet))) (define/public (open-folder path) (dbg-rktplayer "path: ~a" path) (open-file-manager path)) ;(let ((folder (if (file-exists? path) (path-only path) path))) ; (open-file-manager folder))) (define/public (play-or-pause) (cond ((eq? state 'playing) (send player pause!)) ((eq? state 'paused) (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) (unless (= (send playlist length) 0) (send player play-track idx))) (define/public (pause) (send player pause-unpause)) (define/public (next-track) (send player next) ) (define/public (previous-track) (send player previous) ) (define/public (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) (let* ((volume-meter (send this element 'volume-meter)) (volume-display (send volume-meter display)) ) (display "volume-display = ") (write volume-display) (newline) (if (eq? volume-display 'block) (send volume-meter display 'none) (begin (send volume-meter display 'block) (send el-volume set! (send player get-volume)) (send el-vol-perc set-innerHTML! (sprintf "%d%" (send player get-volume)))) ) ) ) (define/public (set-volume! percentage) (send player set-volume! percentage) (send this update-volume) ) (define/public (seek-to percentage) (dbg-rktplayer "Seeking to percentage: ~a" percentage) (send player seek percentage) ) (define/override (quit) (dbg-rktplayer "Quitting") (set! closed #t) (when playlist (send playlist stop-cache!)) (send player quit) (send this close) (dbg-rktplayer "Calling super -> quit") (super quit) ) (define/public (settings-dlg) (let ((dlg (new settings% [settings (send settings clone 'settings-dlg)] [parent this] [renderers dlna-renderers] [libraries-changed-callback (lambda () (initialize-library-browser!) (when page-ready (send this update-main-menu) (send this update-library)))] [cache-cleared-callback (lambda () (when playlist (send playlist reset-cache!) (when page-ready (send this update-playlist))))]))) (send dlg show))) (define/public (select-library) (send this settings-dlg)) (define/public (show-hide) (let ((st (send this window-state))) (if (eq? st 'hidden) (send this present) (send this hide) ) ) ) (define window-state-change-callback (λ () #t)) (define/public (set-window-state-change-callback! f) (set! window-state-change-callback f)) (define/override (window-state-changed st) (window-state-change-callback)) (define/override (can-close?) (show-hide) #f) (begin (dbg-rktplayer "Initializing local player") (play-local) (initialize-library-browser!) (dbg-rktplayer "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)] [cache-updated cache-updated])) (send player set-list! playlist) (dbg-rktplayer "playlist = ~a" playlist) (semaphore-post initialized) ) ) )