Complete refactoring for rktplayer, in order to make it play on DLNA renderers and also use UpNP media server resources.
This commit is contained in:
@@ -0,0 +1,487 @@
|
||||
#lang racket/base
|
||||
|
||||
(require keystore/class
|
||||
racket/class
|
||||
racket/list
|
||||
"../library/library-factory.rkt"
|
||||
"../library/base/media-item.rkt"
|
||||
"playlist-cache.rkt"
|
||||
"playlist-entry.rkt"
|
||||
"../misc/utils.rkt")
|
||||
|
||||
(provide playlist%)
|
||||
|
||||
(define list-length
|
||||
length)
|
||||
|
||||
(define list-for-each
|
||||
for-each)
|
||||
|
||||
(define (valid-track-index? entries idx)
|
||||
(and (exact-nonnegative-integer? idx)
|
||||
(< idx (list-length entries))
|
||||
(send (list-ref entries idx)
|
||||
is-valid?)))
|
||||
|
||||
(define (available-track-index? entries idx)
|
||||
(and (exact-nonnegative-integer? idx)
|
||||
(< idx (list-length entries))
|
||||
(send (list-ref entries idx)
|
||||
is-available?)))
|
||||
|
||||
(define (first-valid-index entries indexes)
|
||||
(for/first ((idx indexes)
|
||||
#:when
|
||||
(valid-track-index? entries idx))
|
||||
idx))
|
||||
|
||||
(define (first-available-index entries indexes)
|
||||
(for/first ((idx indexes)
|
||||
#:when
|
||||
(available-track-index? entries idx))
|
||||
idx))
|
||||
|
||||
(define playlist%
|
||||
(class object%
|
||||
(init-field
|
||||
[max-tracks 100]
|
||||
[name "Default"]
|
||||
[id #f]
|
||||
[settings #f]
|
||||
[cache-updated
|
||||
(lambda (entry downloaded total) (void))])
|
||||
|
||||
(check/c playlist% max-tracks exact-positive-integer?)
|
||||
|
||||
(define store
|
||||
(new keystore%
|
||||
[file 'rktplayer]))
|
||||
|
||||
(define entries
|
||||
'())
|
||||
|
||||
(define cache
|
||||
#f)
|
||||
|
||||
(define factory
|
||||
(get-library-factory))
|
||||
|
||||
(define/private (can-add?)
|
||||
(< (list-length entries)
|
||||
max-tracks))
|
||||
|
||||
(define/private (set-cache! playlist-id)
|
||||
(when cache
|
||||
(send cache stop!))
|
||||
(set! cache
|
||||
(new playlist-cache%
|
||||
[playlist-id playlist-id]
|
||||
[updated cache-updated]))
|
||||
(list-for-each
|
||||
(lambda (entry)
|
||||
(send cache ensure-entry! entry))
|
||||
entries))
|
||||
|
||||
(define/private (add-track* track)
|
||||
(when (can-add?)
|
||||
(let ((entry
|
||||
(track->playlist-entry track)))
|
||||
(set! entries
|
||||
(append entries
|
||||
(list entry)))
|
||||
(when cache
|
||||
(send cache ensure-entry! entry)))))
|
||||
|
||||
(define/private (add-media-item* item)
|
||||
(when (can-add?)
|
||||
(let ((track (send item get-track))
|
||||
(container (send item get-container)))
|
||||
(cond
|
||||
(track
|
||||
(add-track* track))
|
||||
(container
|
||||
(list-for-each
|
||||
(lambda (child)
|
||||
(add-media-item* child))
|
||||
(send container get-items)))))))
|
||||
|
||||
(define/private (sort-entries!)
|
||||
(set! entries
|
||||
(sort
|
||||
entries
|
||||
(lambda (entry-1 entry-2)
|
||||
(let ((track-1 (send entry-1 get-track))
|
||||
(track-2 (send entry-2 get-track)))
|
||||
(and track-1
|
||||
(or (not track-2)
|
||||
(send track-1
|
||||
track<
|
||||
track-2))))))))
|
||||
|
||||
(define/public (tabs)
|
||||
(map
|
||||
(lambda (key)
|
||||
(if (string? key)
|
||||
(string->symbol key)
|
||||
key))
|
||||
(send store
|
||||
get
|
||||
'tabs
|
||||
'(tabkey-default))))
|
||||
|
||||
(define/public (tab-count)
|
||||
(list-length (send this tabs)))
|
||||
|
||||
(define/public (make-tab-key)
|
||||
(string->symbol
|
||||
(format "tabkey-~a-~a"
|
||||
(current-milliseconds)
|
||||
(random 10000))))
|
||||
|
||||
(define/public (get-tab-name idx)
|
||||
(let* ((tabs (send this tabs))
|
||||
(tab-id (list-ref tabs idx))
|
||||
(stored
|
||||
(send store
|
||||
get
|
||||
tab-id
|
||||
(list
|
||||
(format "Playlist-~a" idx)
|
||||
'()))))
|
||||
(car stored)))
|
||||
|
||||
(define/public (set-tab-name! idx new-name)
|
||||
(check/c playlist% set-tab-name!
|
||||
new-name
|
||||
string?)
|
||||
|
||||
(let* ((tabs (send this tabs))
|
||||
(tab-id (list-ref tabs idx))
|
||||
(stored
|
||||
(send store
|
||||
get
|
||||
tab-id
|
||||
(list
|
||||
(format "Playlist-~a" idx)
|
||||
'()))))
|
||||
(send store
|
||||
set!
|
||||
tab-id
|
||||
(list new-name
|
||||
(cadr stored)))))
|
||||
|
||||
(define/public (tab-id idx)
|
||||
(list-ref (send this tabs)
|
||||
idx))
|
||||
|
||||
(define/public (tab-index tab-id)
|
||||
(index-of (send this tabs)
|
||||
tab-id
|
||||
eq?))
|
||||
|
||||
(define/public (drop-tab! idx)
|
||||
(let* ((tabs (send this tabs))
|
||||
(tab-id (list-ref tabs idx)))
|
||||
(when (eq? id tab-id)
|
||||
(when cache
|
||||
(send cache stop!))
|
||||
(set! cache #f))
|
||||
(clear-playlist-cache! tab-id)
|
||||
(send store
|
||||
set!
|
||||
'tabs
|
||||
(list-drop! tabs idx))
|
||||
(send store drop! tab-id)))
|
||||
|
||||
(define/public (add-tab!)
|
||||
(let ((tab-id (send this make-tab-key)))
|
||||
(send store
|
||||
set!
|
||||
'tabs
|
||||
(append (send this tabs)
|
||||
(list tab-id)))))
|
||||
|
||||
(define/public (save-tab!)
|
||||
(let ((idx (send this tab-index id)))
|
||||
(dbg-rktplayer "entry id = ~a, ~a" id idx)
|
||||
(if idx
|
||||
(send store
|
||||
set!
|
||||
id
|
||||
(list
|
||||
(send this get-tab-name idx)
|
||||
(map
|
||||
(lambda (entry)
|
||||
(send entry ->store))
|
||||
entries)))
|
||||
(err-rktplayer
|
||||
"Cannot get tab for id ~a"
|
||||
id))))
|
||||
|
||||
(define/public (load-tab idx)
|
||||
(let* ((tabs (send this tabs))
|
||||
(tab-id (list-ref tabs idx))
|
||||
(stored
|
||||
(send store
|
||||
get
|
||||
tab-id
|
||||
(list "Default" '()))))
|
||||
(dbg-rktplayer "loading ~a" tab-id)
|
||||
(set! id tab-id)
|
||||
(set! name (car stored))
|
||||
(set! entries
|
||||
(filter-map
|
||||
(lambda (stored-track)
|
||||
(store->playlist-entry
|
||||
stored-track
|
||||
factory))
|
||||
(cadr stored)))
|
||||
(set-cache! tab-id))
|
||||
#t)
|
||||
|
||||
(define/public (length)
|
||||
(list-length entries))
|
||||
|
||||
(define/public (first-valid-track-index)
|
||||
(first-valid-index
|
||||
entries
|
||||
(in-range (list-length entries))))
|
||||
|
||||
(define/public (first-available-track-index)
|
||||
(first-available-index
|
||||
entries
|
||||
(in-range (list-length entries))))
|
||||
|
||||
(define/public (next-valid-track-index idx
|
||||
[wrap? #f])
|
||||
(check/c* (playlist% next-valid-track-index)
|
||||
(idx exact-nonnegative-integer?)
|
||||
(wrap? boolean?))
|
||||
|
||||
(or
|
||||
(first-valid-index
|
||||
entries
|
||||
(in-range (+ idx 1)
|
||||
(list-length entries)))
|
||||
(and wrap?
|
||||
(first-valid-index
|
||||
entries
|
||||
(in-range
|
||||
(min (+ idx 1)
|
||||
(list-length entries)))))))
|
||||
|
||||
(define/public (next-available-track-index idx
|
||||
[wrap? #f])
|
||||
(check/c* (playlist% next-available-track-index)
|
||||
(idx exact-nonnegative-integer?)
|
||||
(wrap? boolean?))
|
||||
|
||||
(or
|
||||
(first-available-index
|
||||
entries
|
||||
(in-range (+ idx 1)
|
||||
(list-length entries)))
|
||||
(and wrap?
|
||||
(first-available-index
|
||||
entries
|
||||
(in-range
|
||||
(min (+ idx 1)
|
||||
(list-length entries)))))))
|
||||
|
||||
(define/public (previous-valid-track-index idx
|
||||
[wrap? #f])
|
||||
(check/c* (playlist% previous-valid-track-index)
|
||||
(idx exact-nonnegative-integer?)
|
||||
(wrap? boolean?))
|
||||
|
||||
(or
|
||||
(first-valid-index
|
||||
entries
|
||||
(in-range (- idx 1)
|
||||
-1
|
||||
-1))
|
||||
(and wrap?
|
||||
(first-valid-index
|
||||
entries
|
||||
(in-range
|
||||
(- (list-length entries) 1)
|
||||
(- idx 1)
|
||||
-1)))))
|
||||
|
||||
(define/public (previous-available-track-index idx
|
||||
[wrap? #f])
|
||||
(check/c* (playlist% previous-available-track-index)
|
||||
(idx exact-nonnegative-integer?)
|
||||
(wrap? boolean?))
|
||||
|
||||
(or
|
||||
(first-available-index
|
||||
entries
|
||||
(in-range (- idx 1)
|
||||
-1
|
||||
-1))
|
||||
(and wrap?
|
||||
(first-available-index
|
||||
entries
|
||||
(in-range
|
||||
(- (list-length entries) 1)
|
||||
(- idx 1)
|
||||
-1)))))
|
||||
|
||||
(define/public (add-track track . save?)
|
||||
(add-track* track)
|
||||
(when (null? save?)
|
||||
(send this save-tab!)))
|
||||
|
||||
(define/public (add-media-item item . save?)
|
||||
(check/c playlist% add-media-item
|
||||
item
|
||||
(is-a?/c media-item%))
|
||||
|
||||
(add-media-item* item)
|
||||
(when (null? save?)
|
||||
(send this save-tab!)))
|
||||
|
||||
(define/public (replace-with-media-item! item)
|
||||
(check/c playlist% replace-with-media-item!
|
||||
item
|
||||
(is-a?/c media-item%))
|
||||
|
||||
(when cache
|
||||
(send cache stop!))
|
||||
(clear-playlist-cache! id)
|
||||
(set! entries '())
|
||||
(set! cache #f)
|
||||
(set-cache! id)
|
||||
(add-media-item* item)
|
||||
(sort-entries!)
|
||||
(send this save-tab!))
|
||||
|
||||
(define/public (move-track from-idx to-idx)
|
||||
(unless (= from-idx to-idx)
|
||||
(let* ((entry (list-ref entries from-idx))
|
||||
(target-idx
|
||||
(if (< from-idx to-idx)
|
||||
(- to-idx 1)
|
||||
to-idx))
|
||||
(without-entry
|
||||
(append
|
||||
(take entries from-idx)
|
||||
(drop entries (+ from-idx 1)))))
|
||||
(set! entries
|
||||
(append
|
||||
(take without-entry target-idx)
|
||||
(list entry)
|
||||
(drop without-entry target-idx)))
|
||||
(send this save-tab!))))
|
||||
|
||||
(define/public (drop-id track-id)
|
||||
(let* ((idx (send this index track-id))
|
||||
(entry (list-ref entries idx)))
|
||||
(set! entries
|
||||
(append
|
||||
(take entries idx)
|
||||
(drop entries (+ idx 1))))
|
||||
(when (and cache
|
||||
(not
|
||||
(findf
|
||||
(lambda (other)
|
||||
(equal? (send other get-id)
|
||||
(send entry get-id)))
|
||||
entries)))
|
||||
(send cache drop-entry! entry))
|
||||
(send this save-tab!)))
|
||||
|
||||
(define/public (entry idx)
|
||||
(list-ref entries idx))
|
||||
|
||||
(define/public (track idx)
|
||||
(send (send this entry idx)
|
||||
get-track))
|
||||
|
||||
(define/public (track-file idx)
|
||||
(send (send this entry idx)
|
||||
get-cache-file))
|
||||
|
||||
(define/public (cache-all!)
|
||||
(when cache
|
||||
(list-for-each
|
||||
(lambda (entry)
|
||||
(send cache ensure-entry! entry))
|
||||
entries)))
|
||||
|
||||
(define/public (reset-cache!)
|
||||
(when cache
|
||||
(send cache stop!))
|
||||
(clear-playlist-cache!)
|
||||
(set! cache #f)
|
||||
(set-cache! id))
|
||||
|
||||
(define/public (stop-cache!)
|
||||
(when cache
|
||||
(send cache stop!)
|
||||
(set! cache #f)))
|
||||
|
||||
(define/public (display-tracks)
|
||||
(list-for-each
|
||||
(lambda (entry)
|
||||
(let ((track (send entry get-track)))
|
||||
(if track
|
||||
(send track ->log)
|
||||
(warn-rktplayer
|
||||
"Unavailable track: ~a"
|
||||
(send entry get-title)))))
|
||||
entries))
|
||||
|
||||
(define/public (for-each proc)
|
||||
(for ((entry (in-list entries))
|
||||
(idx (in-naturals)))
|
||||
(proc idx
|
||||
(send entry get-track))))
|
||||
|
||||
(define/public (track-id idx)
|
||||
(string->symbol
|
||||
(format "track-~a"
|
||||
(+ idx 1))))
|
||||
|
||||
(define/public (index track-id)
|
||||
(- (string->number
|
||||
(substring
|
||||
(symbol->string track-id)
|
||||
6))
|
||||
1))
|
||||
|
||||
(super-new)
|
||||
|
||||
(send this load-tab 0)))
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
|
||||
(define test-entry%
|
||||
(class object%
|
||||
(init-field valid?)
|
||||
(define/public (is-valid?) valid?)
|
||||
(define/public (is-available?) valid?)
|
||||
(super-new)))
|
||||
|
||||
(define entries
|
||||
(list
|
||||
(new test-entry% [valid? #f])
|
||||
(new test-entry% [valid? #t])
|
||||
(new test-entry% [valid? #f])
|
||||
(new test-entry% [valid? #t])))
|
||||
|
||||
(check-equal?
|
||||
(first-valid-index
|
||||
entries
|
||||
(in-range (list-length entries)))
|
||||
1)
|
||||
(check-equal?
|
||||
(first-valid-index entries (in-range 2 4))
|
||||
3)
|
||||
(check-false
|
||||
(first-valid-index entries (in-range 4 4)))
|
||||
(check-equal?
|
||||
(first-valid-index entries (in-range 2 -1 -1))
|
||||
1))
|
||||
Reference in New Issue
Block a user