572 lines
20 KiB
Racket
572 lines
20 KiB
Racket
#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 "<img src=\"/get-image?~a&~a\" />"
|
|
(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)
|
|
)
|
|
)
|
|
)
|
|
|
|
|