jianpu8.ly

\version "2.18.2"
% also works with 2.19.x and later

#(define (get-keysig-alt-count alt-alist)
   "Return number of sharps/flats in key sig, (+) for sharps, (-) for flats."
   (if (null? alt-alist)
       0
       (* (length alt-alist) 2 (cdr (car alt-alist)))))

#(define (get-major-tonic alt-count)
   "Return number of the tonic note 0-6, as if the key sig were major."
   ;; (alt-count major-tonic)
   ;; (-7 0) (-5 1) (-3 2) (-1 3) (1 4) (3 5) (5 6) (7 0)
   ;; (-6 4) (-4 5) (-2 6) (0 0) (2 1) (4 2) (6 3)
   (if (odd? alt-count)
       (modulo (- (/ (+ alt-count 1) 2) 4) 7)
       (modulo (/ alt-count 2) 7)))

#(define (get-key-alts context)
   "Needed because LilyPond 2.19 and 2.20 has 'keyAlterations
    and 2.18 has 'keySignature for the same context property.
    No way to test for existence of context property..."
   (define key-alts (ly:context-property context 'keyAlterations '()))
   (if (equal? key-alts '())
       (ly:context-property context 'keySignature '())
       key-alts))


jianpuMusic =
#(define-music-function (parser location mus) (ly:music?)
   "This music function modifies the music input for better jianpu output."
   (let ((major-tonic-pitch (ly:make-pitch 0 0 0)))
     (music-map
      (lambda (m)
        (cond

         ;; KEY CHANGE
         ((music-is-of-type? m 'key-change-event)
          (let*
           ((pitch-alist (ly:music-property m 'pitch-alist))
            (key-alts (filter (lambda (a) (not (= 0 (cdr a)))) pitch-alist))
            (keysig-alt-count (get-keysig-alt-count key-alts))
            (major-tonic-number (get-major-tonic keysig-alt-count))
            (tonic (ly:music-property m 'tonic))
            (tonic-num (ly:pitch-notename tonic))
            ;; mode 1-7, 1=major 6=minor
            (mode (+ 1 (modulo (- tonic-num major-tonic-number) 7))))

           (set! major-tonic-pitch
                 (ly:make-pitch 0
                   major-tonic-number
                   (or (assoc-ref key-alts major-tonic-number) 0)))
           ;; store the actual key of the music for use in jianpu key signatures
           (ly:music-set-property! m 'jianpu-key-sig (cons mode tonic))

           ;; convert the key signature in effect to c major
           (ly:music-set-property! m 'pitch-alist '((0 . 0) (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0) (6 . 0)))
           (ly:music-set-property! m 'tonic (ly:make-pitch 0 0 0))
           ))

         ;; REST AND MULTI-MEASURE REST
         ((or (music-is-of-type? m 'rest-event)
              (music-is-of-type? m 'multi-measure-rest))
          (let ((dur (ly:moment-main (ly:music-duration-length m))))
            (if (>= dur 1/2)
                ;; split whole and half rests into quarter notes
                (let ((q (make-music 'NoteEvent
                           'duration (ly:make-duration 2 0 1)
                           'jianpu-rest #t)))
                  ;; double dotted half rest is special case
                  ;; TODO: generalize this for triple dots, other durations, etc.?
                  (if (= dur 7/8)
                      (let ((q-dotted (ly:music-deep-copy q)))
                        (ly:music-set-property! q-dotted 'duration (ly:make-duration 2 1 1))
                        (set! m (make-sequential-music (append (make-list 2 q) (list q-dotted)))))
                      ;; else
                      (set! m (make-sequential-music (make-list (* 4 dur) q)))))

                ;; shorter rests are just converted into notes without pitches
                ;; and with a jianpu-rest property added
                (begin
                 (ly:music-set-property! m 'name 'NoteEvent)
                 (ly:music-set-property! m 'types
                   (append
                    (delete 'rest-event (ly:music-property m 'types))
                    '(note-event melodic-event)))
                 (ly:music-set-property! m 'jianpu-rest #t)
                 ))))

         ;; NOTE
         ((and (music-is-of-type? m 'note-event)
               (ly:pitch? (ly:music-property m 'pitch)))
          ;; transpose to c major, gives us correct accidentals and octaves "for free"
          (ly:music-set-property! m 'pitch
            (ly:pitch-transpose (ly:music-property m 'pitch)
              (ly:pitch-negate (ly:pitch-diff major-tonic-pitch (ly:make-pitch 0 0 0)))))

          (let* ((octave (ly:pitch-octave (ly:music-property m 'pitch)))
                 (octave-dir (if (> octave 0) 1 -1))
                 (artics (ly:music-property m 'articulations '()))
                 (dur (ly:moment-main (ly:music-duration-length m)))
                 (dot (ly:stencil-translate
                       (make-circle-stencil 0.2 0.001 #t)
                       (cons 0.6 0)))
                 (dot-two (ly:stencil-stack dot Y DOWN dot 0.5 0))
                 (dot-three (ly:stencil-stack dot-two Y DOWN dot 0.5 0))
                 (dot-four (ly:stencil-stack dot-three Y DOWN dot 0.5 0)))

            ;; add octave dot markups as articulations
            ;; from jianpu-ly python script: "-\tweak #'X-offset #0.6 _."
            (if (not (= 0 octave))
                (ly:music-set-property! m 'articulations
                  (append artics
                    (list
                     (make-music 'TextScriptEvent
                       'direction octave-dir
                       'text (markup #:stencil
                               (case (abs octave)
                                 ((1) dot)
                                 ((2) dot-two)
                                 ((3) dot-three)
                                 ((4) dot-four)
                                 (else dot-four)
                                 )))))))

            ;; split whole and half notes into quarter notes, some dashed
            (if (>= dur 1/2)
                (let* ((dash-num (+ -1 (* 4 dur)))
                       (q-dur (ly:make-duration 2 0 1))
                       (q (make-music 'NoteEvent
                            'duration q-dur
                            'pitch (ly:music-property m 'pitch)
                            'jianpu-dash-note #t)))

                  (ly:music-set-property! m 'duration q-dur)

                  (if (= dash-num 5/2)
                      ;; special fix for double-dotted half note
                      ;; TODO: generalize this for triple dots, other durations, etc.?
                      (let ((q-dotted (ly:music-deep-copy q)))
                        (ly:music-set-property! q-dotted 'duration (ly:make-duration 2 1 1))
                        (set! m (make-sequential-music
                                 (append (list m q) (list q-dotted)))))
                      ;; else
                      (set! m (make-sequential-music
                               (append (list m) (make-list dash-num q)))))
                  )))))
        m)
      mus)))


#(define Jianpu_note_head_engraver
   (make-engraver
    (acknowledgers
     ((note-head-interface engraver grob source-engraver)
      ;; make sure \omit is not in effect (stencil is not #f)
      (if (ly:grob-property-data grob 'stencil)
          (let* ((staff-context (ly:translator-context engraver))
                 (event (event-cause grob))
                 (jianpu-dash-note (ly:event-property event 'jianpu-dash-note)))
            (if (equal? #t jianpu-dash-note)
                (ly:grob-set-property! grob 'stencil
                  (ly:stencil-translate
                   (make-connected-path-stencil '((1 0)) 0.3 1 1 #f #f)
                   (cons 0 1)))
                ;; else create number stencil based on the scale degree of the note
                ;; TODO: handle notes without pitches that aren't jianpu-rests
                (let*
                 ((grob-pitch (ly:event-property event 'pitch))
                  (note-number
                   (if (ly:pitch? grob-pitch)
                       (ly:pitch-notename grob-pitch) #f))
                  (jianpu-rest (ly:event-property event 'jianpu-rest))
                  (glyph-string
                   (if (number? note-number)
                       (case (+ 1 note-number)
                         ((1) "one")
                         ((2) "two")
                         ((3) "three")
                         ((4) "four")
                         ((5) "five")
                         ((6) "six")
                         ((7) "seven")
                         (else "zero"))
                       (if (equal? #t jianpu-rest) "zero" #f)))
                  (stl
                   (if (string? glyph-string)
                       (grob-interpret-markup grob
                         (markup #:musicglyph glyph-string)))))
                 (ly:grob-set-property! grob 'stencil stl)
                 ))))))))


#(define Jianpu_flag_engraver
   (make-engraver
    (acknowledgers
     ((flag-interface engraver grob source-engraver)
      ;; make sure \omit is not in effect (stencil is not #f)
      (if (ly:grob-property-data grob 'stencil)
          (let* ((glyph-name (ly:grob-property grob 'glyph-name))
                 (padding 0.35)
                 ;; TODO: width is hard-coded, better to match note-head width
                 ;; TODO: stencil creation could be coded better
                 (flag-one (make-connected-path-stencil '((1.2 0)) 0.15 1 1 #f #f))
                 (flag-two (ly:stencil-stack flag-one Y DOWN flag-one padding 0))
                 (flag-three (ly:stencil-stack flag-two Y DOWN flag-one padding 0))
                 (flag-four (ly:stencil-stack flag-three Y DOWN flag-one padding 0))
                 (flag-five (ly:stencil-stack flag-four Y DOWN flag-one padding 0))
                 (new-stl (cond
                           ((string= glyph-name "flags.d3") flag-one)
                           ((string= glyph-name "flags.d4") flag-two)
                           ((string= glyph-name "flags.d5") flag-three)
                           ((string= glyph-name "flags.d6") flag-four)
                           ((string= glyph-name "flags.d7") flag-five)
                           (else empty-stencil))))

            (ly:grob-set-property! grob 'stencil new-stl)
            (ly:grob-set-property! grob 'Y-offset -2)
            ;; TODO: are these needed?
            ;; (ly:grob-set-property! grob 'X-extent
            ;;  (ly:stencil-extent (ly:grob-property grob 'stencil) X))
            ;; (ly:grob-set-property! grob 'Y-extent
            ;;  (ly:stencil-extent (ly:grob-property grob 'stencil) Y))
            ))))))


#(define (jianpu-beam-adjust grob)
   "Adjusts the width etc. of beams."
   ;; We calculate the amount to scale based on width of beam
   ;; TODO: improve this, maybe by using stems
   (let* ((x-ext (interval-length (ly:stencil-extent (ly:grob-property grob 'stencil) X)))
          (x-scale (+ 1 (/ 1.4 x-ext))))
     ;; (display x-ext)(newline)
     (ly:grob-set-property! grob 'stencil
       ;; (ly:stencil-translate
       (ly:stencil-scale
        (ly:grob-property grob 'stencil)
        x-scale 1)
       ;; (cons 0 0))
       )))


#(define Jianpu_key_engraver
   (make-engraver
    (acknowledgers
     ((key-signature-interface engraver grob source-engraver)
      (let* ((event (event-cause grob))
             (jianpu-key-sig (ly:event-property event 'jianpu-key-sig))
             (tonic-num (car jianpu-key-sig))
             (tonic-pitch (cdr jianpu-key-sig))
             (key-sig-number-string (ly:number->string tonic-num))
             (key-sig-note
              (case (ly:pitch-notename tonic-pitch)
                ((0) "C")
                ((1) "D")
                ((2) "E")
                ((3) "F")
                ((4) "G")
                ((5) "A")
                ((6) "B")
                (else "X")))
             (key-sig-alt
              (case (ly:pitch-alteration tonic-pitch)
                ((1/2) #{ \markup \sharp #})
                ((-1/2) #{ \markup \flat #})
                (else ""))))
        (ly:grob-set-property! grob 'stencil
          (grob-interpret-markup grob
            ;; TODO: scale the flat or sharp size, based on current font size
            (markup key-sig-number-string "=" key-sig-note key-sig-alt)
            )))))))


% Custom "JianpuStaff" Context

\layout {
  \context {
    % \Staff lets us start with all standard staff settings
    \Staff
    % \name gives the custom staff context its name
    \name JianpuStaff
    % \alias Staff tells LilyPond that commands that work on a standard
    % Staff context should also work with this custom context
    \alias Staff
    % customizations
    \consists \Jianpu_note_head_engraver
    \consists \Jianpu_flag_engraver
    \consists \Jianpu_key_engraver

    \override Beam.after-line-breaking = #jianpu-beam-adjust

    \override Accidental.font-size = #-2.5
    \override Clef.stencil = ##f
    \override StaffSymbol.line-count = #0
    \override BarLine.bar-extent = #'(-2 . 2)
    \override TimeSignature.style = #'numbered
    % \override Stem.transparent = ##t
    \override Stem.length = #0
    \override Stem.length-fraction = #0
    \override NoteHead.Y-offset = #-1
    \override Beam.transparent = ##f
    \override Stem.direction = #DOWN
    \override Beam.beam-thickness = #0.15
    \override Beam.length-fraction = #0.5
    \override Tie.staff-position = #2.5
    \override TupletBracket.bracket-visibility = ##t
    \tupletUp
    \slurUp
    % \hide Stem
    \omit Stem
    \override Dots.staff-position = #2
  }
  % define the "parent" contexts that will accept the custom context
  \context { \Score \accepts JianpuStaff }
  \context { \ChoirStaff \accepts JianpuStaff }
  \context { \GrandStaff \accepts JianpuStaff }
  \context { \PianoStaff \accepts JianpuStaff }
  \context { \StaffGroup \accepts JianpuStaff }
}

% And for MIDI
% to avoid warnings it has to be defined for each type of output desired
% but we actually can't use midi with the jianpu music function, so this
% is rather pointless... leaving it in for now.
\midi {
  \context {
    \Staff
    \name JianpuStaff
    \alias Staff
  }
  % since the customizations are for visual output only,
  % there is no need to include them for midi
  \context { \Score \accepts JianpuStaff }
  \context { \ChoirStaff \accepts JianpuStaff }
  \context { \GrandStaff \accepts JianpuStaff }
  \context { \PianoStaff \accepts JianpuStaff }
  \context { \StaffGroup \accepts JianpuStaff }
}