lilypond-user
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Pattern-generating Scheme function challenge


From: Urs Liska
Subject: Re: Pattern-generating Scheme function challenge
Date: Sat, 20 Jul 2013 23:55:02 +0200
User-agent: Mozilla/5.0 (X11; Linux i686; rv:17.0) Gecko/20130510 Thunderbird/17.0.6

Hi Harm,

I did a quick compilation (further investigation to follow) - and that's awesome! Thenk you very much. Of course it will be hard to 'sell' it with a 'hey, look how easy it is to realize that with LilyPond ;-)

Best
Urs


Am 20.07.2013 23:48, schrieb Thomas Morley:
\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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]