#lang racket (require racket-webview racket/runtime-path racket/gui racket-sprintf open-app xml "utils.rkt" "music-library.rkt" "translate.rkt" "playlist.rkt" "player.rkt" ) (provide (all-from-out racket-webview) rktplayer% ) (define-runtime-path rkt-gui-dir "gui") (define player-menu (λ () (wv-menu 'main-menu (wv-menu-item 'm-file (tr "File") #:submenu (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))))) (when (eq? (system-type 'os) 'windows) (set! path (string-replace path "/" "\\"))) (dbg-rktplayer "music-library: ~a" path) path)) (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-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))) ) ) ) ) ) (define current-track-nr #f) (define (update-track-nr nr) (unless (eq? playlist #f) (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) (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) (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/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-pause) (ww-connect 'stop stop) (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)) (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)) (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)) (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) ) (define/public (update-playlist) (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) ) ) ) (update-track-nr current-track-nr) ) ) (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/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))))) (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 ((result (send el-library set-innerHTML! html))) (dbg-rktplayer "set-innerHTML!: ~a" result) (send this scroll-top 'library) (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/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 (wv-menu-item 'm-play-this (tr "Play this") #:callback (λ () (send this play-path path)))))) (when (file-exists? path) (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-folder (tr "Open containing folder") #:callback (λ () (send this open-folder path))) ))) (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) ) ) ) (define/public (play-path path) (dbg-rktplayer "Playing ~a" 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) (send this update-playlist) (send player play pl) (dbg-rktplayer "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) (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) (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 '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)) (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) (dbg-rktplayer "Volume") ) (define/public (seek-to percentage) (dbg-rktplayer "Seeking to percentage: ~a" percentage) (send player seek percentage) ) (define/public (quit) (dbg-rktplayer "Quitting") (send player quit) (set! closed #t) (send this close)) (define/public (select-library) (let ((dir (send this choose-dir (tr "Choose the folder containing your music library") (if (string? music-library) music-library (path->string music-library)) ))) (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) ) ) ) ) (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) ) ) )