Strophensortierung gefixt

This commit is contained in:
tux 2023-09-25 01:39:55 +02:00
parent 15f37accaa
commit 33c3d47504

View File

@ -142,26 +142,25 @@
(verse-hspace 1) (verse-hspace 1)
(verse-ordering-horizontal #f)) (verse-ordering-horizontal #f))
"Gruppiere Strophen in einem Markup auf Wunsch spaltenweise" "Gruppiere Strophen in einem Markup auf Wunsch spaltenweise"
(let ((h (make-hash-table verse-cols)) (define (add-markup-between-elements reverses markup-between elements)
(index 0) ((if reverses fold fold-right) (lambda (element filled-list)
(column-item-count (ceiling (/ (length versegroup) verse-cols)))) (cons element (if (null? filled-list) '() (cons markup-between filled-list))))
(for-each (lambda (el) '() elements))
(let ((i (if verse-ordering-horizontal (let* ((column-item-count (ceiling (/ (length versegroup) verse-cols)))
(column-data (make-list verse-cols)))
(let columnize-list ((index 0) (items versegroup))
(if (not (null? items))
(let* ((column-index (if verse-ordering-horizontal
(modulo index verse-cols) (modulo index verse-cols)
(floor (/ index column-item-count))))) (floor (/ index column-item-count))))
(hashv-set! h i (cons el (hashv-ref h i (list)))) (set! index (+ index 1)))) (column-markups (list-ref column-data column-index)))
versegroup) (list-set! column-data column-index (cons (car items) column-markups))
(columnize-list (+ index 1) (cdr items)))))
(interpret-markup layout props (interpret-markup layout props
(make-fill-line-markup (cons (make-verseformat-markup (make-line-markup (make-fill-line-markup (list (make-verseformat-markup (make-line-markup
(reverse (hash-fold (lambda (key value l) (add-markup-between-elements #f
(cons (make-column-markup (make-hspace-markup verse-hspace)
(fold (lambda (v verses) (map (lambda (column-markups)
(cons v (if (null? verses) (make-column-markup
verses (add-markup-between-elements #t (make-vspace-markup verse-vspace) column-markups)))
(cons (make-vspace-markup verse-vspace) verses)))) column-data)))))))))
(list) value))
(if (null-list? l)
l
(cons (make-hspace-markup verse-hspace) l))))
(list) h))))
(list))))))