\version "2.18.2"

% This file generates a customizable number of random white note pitches
% for identification.  Answers can be displayed.

% The following function is copied from scm/define-markup-commands.scm.
% Not needed in newer versions of LilyPond.
#(define-markup-list-command (table layout props column-align lst)
   (number-list? markup-list?)
   #:properties ((padding 0)
                 (baseline-skip))

   (define (split-lst initial-lst lngth result-lst)
     ;; split a list into a list of sublists of length lngth
     ;; eg. (split-lst '(1 2 3 4 5 6) 2 '())
     ;; -> ((1 2) (3 4) (5 6))
     (cond ((not (integer? (/ (length initial-lst) lngth)))
            (ly:warning
             "Can't split list of length ~a into ~a parts, returning empty list"
             (length initial-lst) lngth)
            '())
       ((null? initial-lst)
        (reverse result-lst))
       (else
        (split-lst
         (drop initial-lst lngth)
         lngth
         (cons (take initial-lst lngth) result-lst)))))

   (define (dists-list init padding lst)
     ;; Returns a list, where each element of `lst' is
     ;; added to the sum of the previous elements of `lst' plus padding.
     ;; `init' will be the first element of the resulting list. The addition
     ;; starts with the values of `init', `padding' and `(car lst)'.
     ;; eg. (dists-list 0.01 0.1 '(1 2 3 4)))
     ;; -> (0.01 1.11 3.21 6.31 10.41)
     (if (or (not (number? init))
             (not (number? padding))
             (not (number-list? lst)))
         (begin
          (ly:warning
           "not fitting argument for `dists-list', return empty lst ")
          '())
         (reverse
          (fold (lambda (elem rl) (cons (+ elem padding (car rl)) rl))
            (list init)
            lst))))

   (let* (;; get the number of columns
           (columns (length column-align))
           (init-stils (interpret-markup-list layout props lst))
           ;; If the given markup-list is the result of a markup-list call, their
           ;; length may not be easily predictable, thus we add point-stencils
           ;; to fill last row of the table.
           (rem (remainder (length init-stils) columns))
           (filled-stils
            (if (zero? rem)
                init-stils
                (append init-stils (make-list (- columns rem) point-stencil))))
           ;; get the stencils in sublists of length `columns'
           (stils
            (split-lst filled-stils columns '()))
           ;; procedure to return stencil-length
           ;; If it is nan, return 0
           (lengths-proc
            (lambda (m)
              (let ((lngth (interval-length (ly:stencil-extent m X))))
                (if (nan? lngth) 0 lngth))))
           ;; get the max width of each column in a list
           (columns-max-x-lengths
            (map
             (lambda (x)
               (apply max 0
                 (map
                  lengths-proc
                  (map (lambda (l) (list-ref l x)) stils))))
             (iota columns)))
           ;; create a list of (basic) distances, which each column should
           ;; moved, using `dists-list'. Some padding may be added.
           (dist-sequence
            (dists-list 0 padding columns-max-x-lengths))
           ;; Get all stencils of a row, moved accurately to build columns.
           ;; If the items of a column are aligned other than left, we need to
           ;; move them to avoid collisions:
           ;; center aligned: move all items half the width of the widest item
           ;; right aligned: move all items the full width of the widest item.
           ;; Added to the default-offset calculated in `dist-sequence'.
           ;; `stencils-for-row-proc' needs four arguments:
           ;;    stil    - a stencil
           ;;    dist    - a numerical value as basic offset in X direction
           ;;    column  - a numerical value for the column we're in
           ;;    x-align - a numerical value how current column should be
           ;;              aligned, where (-1, 0, 1) means (LEFT, CENTER, RIGHT)
           (stencils-for-row-proc
            (lambda (stil dist column x-align)
              (ly:stencil-translate-axis
               (ly:stencil-aligned-to stil X x-align)
               (cond ((member x-align '(0 1))
                      (let* (;; get the stuff for relevant column
                              (stuff-for-column
                               (map
                                (lambda (s) (list-ref s column))
                                stils))
                              ;; get length of every column-item
                              (lengths-for-column
                               (map lengths-proc stuff-for-column))
                              (widest
                               (apply max 0 lengths-for-column)))
                        (+ dist (/ widest (if (= x-align 0) 2 1)))))
                 (else dist))
               X)))
           ;; get a list of rows using `ly:stencil-add' on a list of stencils
           (rows
            (map
             (lambda (stil-list)
               (apply ly:stencil-add
                 (map
                  ;; the procedure creating the stencils:
                  stencils-for-row-proc
                  ;; the procedure's args:
                  stil-list
                  dist-sequence
                  (iota columns)
                  column-align)))
             stils)))
     (space-lines baseline-skip rows)))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(let ((time (gettimeofday)))
   (set! *random-state*
         (seed->random-state (+ (car time)
                               (cdr time)))))

%% Readable ranges for allowed clefs
#(define clef-ranges
   `(
      ("treble" . (,(ly:make-pitch -1 2) ,(ly:make-pitch 2 6)))
      ("alto" . (,(ly:make-pitch -1 0) ,(ly:make-pitch 1 0)))
      ("tenor" . (,(ly:make-pitch -1 0) ,(ly:make-pitch 1 0)))
      ("bass" . (,(ly:make-pitch -2 0) ,(ly:make-pitch 0 1)))
      ))

#(define accidentals-no-doubles
   (list -1/2 0 1/2))

%% Calculate base interval
#(define (calc-white-note-span note1 note2)
   (let ((o1 (ly:pitch-octave note1))
         (o2 (ly:pitch-octave note2))
         (nn1 (ly:pitch-notename note1))
         (nn2 (ly:pitch-notename note2)))
     (+ (* (- o2 o1) 7)
       (1+ (- nn2 nn1)))))

#(define (make-note pitch dur)
   (make-music
    'NoteEvent
    'duration
    (ly:make-duration dur)
    'pitch
    pitch))

#(define (get-random-pitch clef acc-pool)
   (let* ((range (ly:assoc-get clef clef-ranges))
          (white-notes (calc-white-note-span (car range) (cadr range)))
          (random-pitch-diff (random white-notes)))
     (ly:make-pitch
      (ly:pitch-octave (car range))
      (+ random-pitch-diff (ly:pitch-notename (car range)))
      (list-ref acc-pool (random (length acc-pool))))))

questions =
#(define-music-function (parser location num acc-pool)
   (number? list?)
   (let ((clef-list
          (circular-list "treble" "bass" "alto" "bass" "treble" "tenor")))
     (let loop ((x 0) (cl clef-list) (return '()))
       (if (< x num)
           (loop
            (1+ x)
            (cdr cl)
            (append return
              (list
               #{ \clef #(car cl) #}
               (make-note (get-random-pitch (car cl) acc-pool) 0))))

           #{
             {
               address@hidden
             }
           #}))))

rep = #'("C" "D" "E" "F" "G" "A" "B")

#(define alteration-symbols
   `(
      (-1/2 . ,#{ \markup \general-align #Y #DOWN \fontsize #-2 \flat #})
      (0 . ,#{ \markup \null #})
      (1/2 . ,#{ \markup { \hspace #0.1 \general-align #Y #-0.5 \fontsize #-2 \sharp } #})
      ))

#(define (format-note-name p)
   (let* ((letter (list-ref rep (ly:pitch-notename p)))
          (alteration
           (ly:assoc-get (ly:pitch-alteration p) alteration-symbols)))
     #{
       \markup {
         \concat {
           \sans #letter
           #alteration
         }
       }
     #}))

#(define (format-answers answers)
   (let* ((notes (extract-named-music answers 'NoteEvent))
          (pitches (map (lambda (n) (ly:music-property n 'pitch)) notes))
          (name-str
           (map (lambda (n)
                  (make-concat-markup
                   (list (format-note-name n)
                     (number->string (+ (ly:pitch-octave n) 4)))))
             pitches)))
     name-str))

#(define (build-answer-list-for-table answers show?)
   (let ((answers (format-answers answers)))
     (let loop ((idx 1) (return '()) (ls answers))
       (if (null? ls)
           (reverse return)
           (loop
            (1+ idx)
            (cons
             #{
               \markup \concat {
                 #(string-append (number->string idx) ". ")
                 #(if show?
                      (make-italic-markup (car ls))
                      "_____")
               }
             #}
             return)
            (cdr ls))))))

blanks =
#(define-scheme-function (parser location num) (number?)
   (let ((str (map (lambda (n) (string-append (number->string n) ". ____"))
                (iota num 1))))
     #{
       \lyricmode { address@hidden }
     #}))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(set-default-paper-size "letter")

\paper {
  left-margin = 0.75\in
  right-margin = #left-margin
  top-margin = 1\in
  bottom-margin = #top-margin
  markup-markup-spacing.padding = 3
  markup-system-spacing.padding = 3
  system-system-spacing.padding = 4
  page-breaking = #ly:minimal-breaking
  tagline = ##f
}

\header {
  title = "Note Reading Practice (All clefs)"
}

\markup \wordwrap {
  Identify the following pitches with name and
  octave number.  Answers are given below.
}

test = \questions 30 #accidentals-no-doubles

\new Staff <<
  \new Voice = "notes" {
    \bar "" % so first bar number printed
    \test
  }
  \new Lyrics \lyricsto "notes" {
    \blanks #30
  }
>>

\bookpart { }

\markup \fill-line { "" \bold \huge ANSWERS "" }

\markuplist {
  \override #'(padding . 3)
  \override #'(baseline-skip . 3)
  \override #'(font-size . -1)
  \table
  #`,(make-list 10 -1)
  {
    #@(build-answer-list-for-table test #t)
  }
}

\layout {
  \context {
    \Staff
    \omit TimeSignature
    \override Clef.full-size-change  = ##t
    explicitClefVisibility = #end-of-line-invisible
  }
  \context {
    \Lyrics
    \override LyricText.font-shape = #'italic
    \override VerticalAxisGroup.nonstaff-relatedstaff-spacing =
    #'((basic-distance . 6) (padding . 4))
  }
  \context {
    \Score
    \omit BarNumber
    \override SpacingSpanner.base-shortest-duration = #(ly:make-moment 1/32)
    \override BreakAlignment.break-align-orders =
    ##((left-edge                 ;; end-of-line
         cue-end-clef
         ambitus
         breathing-sign
         clef
         cue-clef
         staff-bar
         key-cancellation
         key-signature
         time-signature
         custos)
       (left-edge                 ;; unbroken
         cue-end-clef
         ambitus
         breathing-sign
         staff-bar
         clef
         cue-clef
         key-cancellation
         key-signature
         time-signature
         custos)
       (left-edge                 ;; beginning-of-line
         ambitus
         breathing-sign
         clef
         key-cancellation
         key-signature
         time-signature
         staff-bar
         cue-clef
         custos))
  }
}