488 lines
13 KiB
Racket
488 lines
13 KiB
Racket
#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))
|