372 lines
13 KiB
Racket
372 lines
13 KiB
Racket
#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
|
|
(displayln "Updating time widgets")
|
|
(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)))))
|
|
;(displayln (format "seeker = ~a" seeker))
|
|
(send el-seeker set! (format "~a" seeker)))
|
|
(displayln "done")
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(define current-track-nr #f)
|
|
(define (update-track-nr nr)
|
|
(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 "/tmp/cover-image")
|
|
(stored-file (send track image->file img-file))
|
|
)
|
|
(unless (eq? stored-file #f)
|
|
(let ((el (send this element 'album-art)))
|
|
(let ((html (format "<img src=\"~a\" />" stored-file)))
|
|
(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))
|
|
(set! playlist (new playlist% [start-map path]))
|
|
(send playlist read-tracks)
|
|
(displayln (format "number of tracks: ~a" (send playlist length)))
|
|
(send this update-playlist)
|
|
(send player play playlist)
|
|
)
|
|
|
|
(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)))
|
|
)
|
|
)
|
|
)
|
|
|
|
|