Re: Pattern-generating Scheme function challenge

[Thomas Morley]

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