Hi Urs,
below my approach.
Though, the function only needs one argument. :)
\version "2.17.22"
%% While compiling with 2.16.2, a little modification in \layout is
%% recommended.
%% Used to get access to integer->list
%% Though, returns a warning:
%% imported module (srfi srfi-60) overrides core binding `bit-count'
#(use-modules (srfi srfi-60))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% definitions, helpers and functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% c/p from lily-library.scm
%% Why not public?
#(define (list-minus a b)
"Return list of elements in A that are not in B."
(lset-difference eq? a b))
%% Affects beaming for mixed notes and rests.
%% For debugging, uncomment modified 'thickness and 'color
#(define modify-beaming
(lambda (grob)
(let* ((all-stems
(ly:grob-array->list (ly:grob-object grob 'stems)))
(visible-stems
(ly:grob-array->list (ly:grob-object grob 'normal-stems)))
;; not visible stems
(stx (list-minus all-stems visible-stems)))
(map
(lambda (x y z)
(let* ((beaming-x (ly:grob-property x 'beaming))
(beaming-y (ly:grob-property y 'beaming))
(all-stems-length (length all-stems)))
(cond
;;RED
((and (member x visible-stems)
(member y stx)
(or (member z visible-stems) (member z stx))
(not (equal? x (first all-stems))))
;(ly:grob-set-property! x 'thickness 10)
;(ly:grob-set-property! x 'color red)
(ly:grob-set-property! x 'beaming
(cons (car beaming-x) (list 0))))
;;CYAN
((and (member x visible-stems)
(member y visible-stems)
(member z stx)
(equal? x (first all-stems)))
;(ly:grob-set-property! y 'thickness 10)
;(ly:grob-set-property! y 'color cyan)
(ly:grob-set-property! y 'beaming
(cons (car beaming-y) (list 0))))
;;BLUE
((and (member x stx)
(member y visible-stems)
(member z visible-stems))
;(ly:grob-set-property! y 'thickness 10)
;(ly:grob-set-property! y 'color blue)
(ly:grob-set-property! y 'beaming
(cons (list 0) (cdr beaming-y))))
(else #f))))
all-stems
(cdr all-stems)
(cddr all-stems))
;; print only one beam over rests
(map
(lambda (x)
(ly:grob-set-property! x 'beaming (cons (list 0) (list 0))))
stx))))
modifyBeaming = \override Beam #'after-line-breaking = #modify-beaming
#(define (position-in-list obj ls)
"Search the positions of obj in ls"
(define (position-in-list-helper obj ls ls1 bypassed)
(if (null? ls)
(reverse ls1)
(if (equal? obj (car ls))
(position-in-list-helper
obj (cdr ls) (cons bypassed ls1) (+ bypassed 1))
(position-in-list-helper
obj (cdr ls) ls1 (+ bypassed 1)))))
(position-in-list-helper obj ls '() 0))
pattern =
#(define-music-function (parser location dur-log n)(integer? integer?)
"
Returns one musical pattern, depending on
@var{dur-log} for the general duration of note and rests
@var{n} as the integer, whose bitwise representation is used
to build the pattern.
"
(let* ((bool-list (integer->list n))
(bool-list-length (length bool-list))
(trues (position-in-list #t bool-list))
(trues-length (length trues))
(music (map
(lambda (t c)
(if t
(make-music
'NoteEvent
'duration (ly:make-duration dur-log 0 1)
'pitch (ly:make-pitch 1 0 0)
'articulations
(if (and (> dur-log 2) (> trues-length 1))
(cond ((= (car trues) c)
(list (make-music
'BeamEvent
'span-direction
-1)))
((= (car (last-pair trues)) c)
(list (make-music
'BeamEvent
'span-direction
1)))
(else '()))
'()))
(make-music
'RestEvent
'duration (ly:make-duration dur-log 0 1))))
bool-list (iota bool-list-length))))
(make-music 'SequentialMusic 'elements music)))
repeatUnfoldVar =
#(define-music-function (parser location n m)(integer? ly:music?)
" A little helper."
#{ \repeat unfold $n $m #})
output =
#(define-music-function (parser location val)(integer?)
"
Returns a StaffGroup using musical patterns created with @code{\\pattern}.
The patterns are created by transforming integers into bits.
All integers are affected up to the value determined by @var{val} and the
calculation @samp{(- (expt 2 val) 2)}.
"
#{
\new StaffGroup
$(make-simultaneous-music
(map
(lambda (x)
#{
\new RhythmicStaff {
\clef percussion
<<
#(make-sequential-music
(map
(lambda (y)
(ly:music-compress
#{
\set Staff.timeSignatureFraction =
#(cons (length (integer->list y)) (expt 2 x))
\pattern #x #y
\bar "|"
#}
(ly:make-moment
(expt 2 x) (length (integer->list y)))))
(iota (- (expt 2 val) 2) 2 1)))
%% Insert RehearsalMarks and line-breaks, using a second
%% voice.
{
\mark \default s1*2 \break
\repeatUnfoldVar #(- (expt 2 (- val 2)) 1)
{ \mark \default s1*4 \break }
}
>>
}
#})
(iota 5 1 1)))
#})
%%%%%%%%%%%%%%%%%%%%%
%% \paper and \layout
%%%%%%%%%%%%%%%%%%%%%
\paper {
min-systems-per-page = 2
max-systems-per-page = 2
ragged-last-bottom = ##f
system-count = 64
% page-count = 32
indent = 0
top-margin = 3\cm
bottom-margin = 3\cm
}
\layout {
\context {
\RhythmicStaff
\consists "Clef_engraver"
\numericTimeSignature
\modifyBeaming
% control the spacing between the staves
\override VerticalAxisGroup
#'default-staff-staff-spacing
#'basic-distance = #13
}
\context {
\StaffGroup
\override SystemStartBracket #'stencil = ##f
}
\context {
% global score settings
\Score
% Remove printing of barnumbers
\remove Bar_number_engraver
% Prevent reminder time signatures to be printed at the end of a line
\override TimeSignature #'break-visibility = #'#(#f #f #t)
% Let rehearsal marks be printed as numbers with a box
markFormatter = #format-mark-box-numbers
% remove connecting line at system start
% (note that we don't have to do that explicitly
% for the rest of the system because we define
% the staves as individual staves later)
\override SystemStartBar #'stencil = ##f
\override SpanBar #'stencil = ##f
\override RehearsalMark #'break-align-symbols = #'(clef)
% Needed in 2.17.22 to center RehearsalMark on clef
% Comment it with 2.16.2
\override RehearsalMark #'self-alignment-X = #0.5
defaultBarType = #""
\override NonMusicalPaperColumn #'line-break-permission = ##f
}
}
%%%%%%%%%%%%%%%%%%
%% The final call:
%%%%%%%%%%%%%%%%%%
\output #8
HTH,
Harm
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-user
