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