commit - 9e2db7b073ec8f5efc39c7f57b0a0b28f0b40933
commit + ffb7bf10fb6c9d5f8cfacec3559a6a721fffc2e4
blob - 14e6c56e3ed6701066aae734fe37cd43cda677dd
blob + 3407e92ab9a9dabe8bbb04d33ad97f1aaea6da8f
--- README.md
+++ README.md
m months w weeks l labels
a artists s search r random play
p play release q queue release
+pa play buffer qa queue buffer
nn next page pp prev page b back
? help / filter
x exit
`:search Autechre`
are also accepted.
-`r` prompts for a random-release count (default: 5). Use `p 4 5 2` to append
-visible releases 4, 5, and 2 and start the first one. Use `q 4 5 2` to append
-them without changing playback.
+`r` plays random releases from the current buffer. mcol asks for a count and
+defaults to 5. `pa` plays every release in the current buffer. `qa` adds every
+release in the current buffer to the queue. Use `p 4 5 2` to play releases 4, 5
+and 2 from the visible page. mcol adds them to the queue and starts the first
+one. Use `q 4 5 2` to add them to the queue without playing.
## Build and install
blob - 7379731b83ccd1cc1a32ff103eb6d085a7d17ac8
blob + 72778315b5c77ca53c9db9d0b0f203f3b95d0211
--- doc/mcol.1
+++ doc/mcol.1
Search artists, labels, releases, and paths.
.TP
.B r
-Play randomly selected releases. It prompts for a count and defaults to 5.
+Play a random set of releases from the current buffer (the release rows shown
+in the current view, not just the visible page). mcol prompts for a count
+and defaults to 5.
.TP
+.BR pa , " qa"
+Play all releases in the current buffer with
+.BR pa ,
+or queue them with
+.BR qa .
+.TP
.B p
Append the selected release to the MPD queue and play its first track.
.B p N ...
blob - aed87331336bdae87ea7b7e8eafcdc103b6f5a0c
blob + 9a40b996cbc13bbaaaee79c3852e729732b11e17
--- src/mcol/tui.sls
+++ src/mcol/tui.sls
(library
(mcol tui)
- (export run-tui)
+ (export run-tui random-from-pool release-paths remove-at make-row)
(import (chezscheme)
(mcol core))
(define esc (string (integer->char 27)))
#t))))
items)))
(define-record-type row (fields label action path))
+ (define (remove-at items index)
+ (let loop ([items items] [index index] [result '()])
+ (if (= index 0)
+ (append (reverse result) (cdr items))
+ (loop (cdr items) (- index 1) (cons (car items) result)))))
+ (define (random-from-pool count pool)
+ (let loop ([available pool] [count count] [result '()])
+ (if (= count 0)
+ (reverse result)
+ (let ([index (random (length available))])
+ (loop (remove-at available index)
+ (- count 1)
+ (cons (list-ref available index) result))))))
+ (define (release-paths rows)
+ (let loop ([rows rows] [result '()])
+ (if (null? rows)
+ (reverse result)
+ (let ([path (row-path (car rows))])
+ (if path
+ (loop (cdr rows) (cons path result))
+ (loop (cdr rows) result))))))
(define (run-tui report)
(let* ([months (or (field report
'months)
[status-message ""]
[status-error? #t]
[current-actions '()]
+ [current-rows '()]
[running? #t])
(define (open next . argument)
maximum)))))))
rows))))
(define search-items (unique-by-path (append catalog events)))
- (define (remove-at items index)
- (let loop ([items items] [index index] [result '()])
- (if (= index 0)
- (append (reverse result) (cdr items))
- (loop (cdr items) (- index 1) (cons (car items) result)))))
- (define (random-releases count)
- (let loop ([available search-items] [count count] [result '()])
- (if (= count 0)
- (reverse result)
- (let ([index (random (length available))])
- (loop (remove-at available index)
- (- count 1)
- (cons (field (list-ref available index) 'path) result))))))
+ (define (buffer-releases)
+ (release-paths current-rows))
+ (define (play-random count)
+ (let ([buffer (buffer-releases)])
+ (cond
+ [(null? buffer) (status! "no releases in current buffer" #t)]
+ [(> count (length buffer)) (status! (format "only ~a releases in current buffer" (length buffer)) #t)]
+ [else (play-releases (random-from-pool count buffer))])))
+ (define (play-all)
+ (let ([paths (buffer-releases)])
+ (if (null? paths)
+ (status! "no releases in current buffer" #t)
+ (play-releases paths))))
+ (define (queue-all)
+ (let ([paths (buffer-releases)])
+ (if (null? paths)
+ (status! "no releases in current buffer" #t)
+ (queue-releases paths))))
(define items-by-path
(let ([index (make-hashtable string-hash string=?)])
(for-each (lambda (item)
"w weeks l labels"
"a artists s search r random play"
"p [N...] play release(s) q [N...] queue release(s)"
- "r random play (default: 5 releases)"
+ "pa play buffer qa queue buffer"
+ "r random play (default: 5 from buffer)"
"/x labels/artists"
":label NAME :artist NAME"
":month YYYY-MM :day YYYY-MM-DD"
info)
(when (pair? info)
(newline))
+ (set! current-rows rows)
(let* ([page-size (terminal-lines)]
[page-count (max 1 (inexact->exact (ceiling (/ (length rows) page-size))))]
[safe-page (min page (- page-count 1))]
(let ([answer (get-line (current-input-port))])
(cond
[(eof-object? answer) (set! running? #f)]
- [(string=? answer "") (play-releases (random-releases 5))]
+ [(string=? answer "") (play-random 5)]
[else
(let ([count (string->number answer)])
(cond
[(or (not count) (not (integer? count)) (<= count 0))
(status! "random play expects a positive number" #t)]
- [(> count (length search-items))
- (status! (format "only ~a releases available" (length search-items)) #t)]
- [else (play-releases (random-releases count))]))]))]
+ [else (play-random count)]))]))]
+ [(string=? verb "pa") (play-all)]
+ [(string=? verb "qa") (queue-all)]
[(string=? verb "p") (batch-release-action "p" arguments play-releases)]
[(string=? verb "q") (batch-release-action "q" arguments queue-releases)]
[(string=? input "s")
blob - 165a4525ba0b0223d72675436d2236c62af10e0c
blob + 6cf5db2f0f80ac83a7a8d40781efa3c9ed6a0393
--- test/test.ss
+++ test/test.ss
(import (chezscheme)
- (mcol core))
+ (mcol core)
+ (mcol tui))
(define checks 0)
(define (check value message)
(set! checks (+ checks 1))
(unless value
(error 'mcol-test message)))
+(define (unique-count items)
+ (let loop ([items items] [seen '()])
+ (if (null? items)
+ (length seen)
+ (if (member (car items) seen)
+ (loop (cdr items) seen)
+ (loop (cdr items) (cons (car items) seen))))))
(define (field object
key)
(check (= 2 (length (field report 'weeks))) "demo weeks")
(check (= 9 (length (field report 'labels))) "demo labels")))
+(define (tui-test)
+ ;; remove-at removes a single element at the given index
+ (check (equal? (remove-at '(a b c d) 0) '(b c d)) "remove-at head")
+ (check (equal? (remove-at '(a b c d) 3) '(a b c)) "remove-at tail")
+ (check (equal? (remove-at '(a b c d) 2) '(a b d)) "remove-at middle")
+ (check (null? (remove-at '(a) 0)) "remove-at singleton")
+ ;; release-paths keeps only rows that carry a release path
+ (let ([rows (list (make-row "x" (lambda () #f) "/p1")
+ (make-row "y" #f #f)
+ (make-row "z" (lambda () #f) "/p2")
+ (make-row "w" #f #f))])
+ (check (equal? (release-paths rows) '("/p1" "/p2")) "release-paths skips non-release rows")
+ (check (null? (release-paths '())) "release-paths empty"))
+ ;; random-from-pool: count distinct items, all drawn from the pool
+ (let* ([pool '(a b c d e f)]
+ [picked (random-from-pool 3 pool)])
+ (check (= (length picked) 3) "random-from-pool count")
+ (check (for-all (lambda (item) (member item pool)) picked) "random-from-pool membership")
+ (check (= (unique-count picked) (length picked)) "random-from-pool distinct"))
+ (check (null? (random-from-pool 0 '(a b c))) "random-from-pool zero")
+ (check (equal? (random-from-pool 1 '(only)) '(only)) "random-from-pool singleton")
+ ;; drawing the whole pool is a permutation: distinct and same membership
+ (let* ([pool '(a b c d e)]
+ [picked (random-from-pool (length pool) pool)])
+ (check (= (length picked) (length pool)) "random-from-pool full length")
+ (check (equal? (sort (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
+ picked)
+ (sort (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
+ pool))
+ "random-from-pool full is a permutation")))
+
(utility-test)
(fixture-test)
(demo-test)
+(tui-test)
(format #t "mcol: ~a checks passed~%" checks)
