#lang racket (require web-racket racket/runtime-path racket/gui racket-sprintf "utils.rkt" "music-library.rkt" "translate.rkt" "playlist.rkt" "player.rkt" ) (provide (all-from-out web-racket) rktplayer% ) (define-runtime-path rktplayer-start "gui/rktplayer.html") (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% (inherit-field settings) (super-new [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 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 (if (= ls 0) 0.0 (exact->inexact (/ (* 100 as) ls))))) (send el-seeker set! (format "~a" seeker))) ) ) ) ) ) (define current-track-nr #f) (define (update-track-nr nr) (unless (eq? playlist #f) (displayln (format "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") (unless (eq? current-track-nr #f) (displayln (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") (unless (eq? current-track-nr #f) (displayln (format "current new track: ~a" (id))) (let ((el (send this element (id)))) (send el add-class! "current")) (displayln "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))) (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 "" stored-file (current-milliseconds)))) (send el set-inner-html! html)))) ;(send el set-attr! 'src stored-file)))) ) ) (displayln" Done updating track") ) ) ) (define state #f) (define (update-state st) (unless (eq? st state) (set! state st) (if (eq? st 'playing) (let ((btn (send this element 'play-img))) (send btn set-attr! 'src "buttons/stop.svg")) (let ((btn (send this element 'play-img))) (send btn set-attr! 'src "buttons/play.svg"))))) (define player (new player% [time-updater update-time] [track-nr-updater update-track-nr] [state-updater update-state] [settings settings] )) (define inner-html-handlers (make-hash)) (define/override (html-loaded) (super html-loaded) (ww-connect 'play play-or-stop) (ww-connect 'pause pause) (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)) (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))) (send this connect-menu! 'm-select-library-dir (λ () (send this select-library))) (send this update-library) ) (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)))) ) ) ) ) ) (displayln "Done.") (update-track-nr current-track-nr) ) ) (define/public (scroll-top id) (send this exec-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/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 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) )))) )) ) (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 ((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) ) ) ) (define/public (play-path path) (displayln (format "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))) ) ) (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))) (define/public (open-folder path) (displayln 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) (begin (send player stop) (update-time 0.0 0.0)) (send player play-track current-track-nr)) ) (define/public (play-track idx) (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) (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 player quit) (set! closed #t) (send this close)) (define/public (select-library) ;(set! music-library "c:\\Users\\Hans") (let ((handle (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 (set! music-library dir) (send settings set! 'music-library dir) (set! current-music-path #f) (send this update-library))) (begin (let ((lang (send settings get 'lang 'en))) (displayln (format "RktPlayer started, current language: ~a" lang))) ) ) )