Strophensortierung gefixt
This commit is contained in:
parent
15f37accaa
commit
33c3d47504
@ -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
|
||||
(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)
|
||||
(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))))))
|
||||
(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))))
|
||||
(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 (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)))))))))
|
Loading…
Reference in New Issue
Block a user