commit ffb7bf10fb6c9d5f8cfacec3559a6a721fffc2e4 from: mtmn date: Tue Aug 25 16:05:58 2026 UTC random picks current buffer, qa/pa binds commit - 9e2db7b073ec8f5efc39c7f57b0a0b28f0b40933 commit + ffb7bf10fb6c9d5f8cfacec3559a6a721fffc2e4 blob - 14e6c56e3ed6701066aae734fe37cd43cda677dd blob + 3407e92ab9a9dabe8bbb04d33ad97f1aaea6da8f --- README.md +++ README.md @@ -43,6 +43,7 @@ make tui INPUT=demo 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 @@ -53,9 +54,11 @@ Enter a row number to open it. Commands such as `:mont `: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 @@ -70,8 +70,16 @@ Show months, weeks, labels, or artists. 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 @@ -1,6 +1,6 @@ (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))) @@ -110,6 +110,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) @@ -145,6 +166,7 @@ [status-message ""] [status-error? #t] [current-actions '()] + [current-rows '()] [running? #t]) (define (open next . argument) @@ -269,19 +291,24 @@ 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) @@ -703,7 +730,8 @@ "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" @@ -765,6 +793,7 @@ 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))] @@ -848,15 +877,15 @@ (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 @@ -1,11 +1,19 @@ (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) @@ -131,7 +139,39 @@ (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) (stringstring x) (symbol->string y))) + picked) + (sort (lambda (x y) (stringstring 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)