X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fflag-styles.scm;h=ab61921851ff60c05bf77f783085bbdb9f362a40;hb=HEAD;hp=83ee50e97d5d42e71d948fc58686bc0fc4ca214f;hpb=1987047329ca97c6b81aea4ded4b3e127c8c2d93;p=lilypond.git diff --git a/scm/flag-styles.scm b/scm/flag-styles.scm index 83ee50e97d..ab61921851 100644 --- a/scm/flag-styles.scm +++ b/scm/flag-styles.scm @@ -1,10 +1,27 @@ -;;;; flag-styles.scm +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPOnd music typesetter +;;;; Copyright (C) 2008--2015 Reinhold Kainhofer ;;;; +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . + +;;;; This file implements different flag styles in Scheme / GUILE, most +;;;; notably the old-straight-flag, the modern-straight-flag and the flat-flag +;;;; styles. + -(define-public (no-flag stem-grob) - "No flag: Simply return empty stencil" +(define-public (no-flag grob) + "No flag: Simply return empty stencil." empty-stencil) @@ -13,27 +30,27 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-public (add-stroke-straight stencil stem-grob stem-up? log stroke-style offset length thickness stroke-thickness) - "Add the stroke for acciaccatura to the given flag stencil." - (let* ((udmult (if stem-up? 1 -1)) - (start (offset-add offset (cons 0 (* (/ length 2) udmult)))) - (end (offset-add (cons 0 (cdr offset)) - (cons (- (/ (car offset) 2)) (* (- (+ thickness (car offset))) udmult)))) +(define-public (add-stroke-straight stencil grob dir log stroke-style + offset length thickness stroke-thickness) + "Add the stroke for acciaccatura to the given flag stencil. +The stroke starts for up-flags at `upper-end-of-flag + (0,length/2)' +and ends at `(0, vertical-center-of-flag-end) - (flag-x-width/2, +flag-x-width + flag-thickness)'. Here `length' is the +whole length, while `flag-x-width' is just the x-extent and thus depends on +the angle! Other combinations don't look as good. + +For down-stems the y-coordinates are simply mirrored." + (let* ((stem-grob (ly:grob-parent grob X)) + (start (offset-add offset (cons 0 (* (/ length 2) dir)))) + (end (offset-add (cons 0 (cdr offset)) + (cons (- (/ (car offset) 2)) (* (- (+ thickness (car offset))) dir)))) (stroke (make-line-stencil stroke-thickness (car start) (cdr start) (car end) (cdr end)))) - (ly:stencil-add stencil stroke))) - -(define (polar->rectangular radius angle-in-degrees) - "Convert polar coordinate @code{radius} and @code{angle-in-degrees} - to (x-length . y-length)" - (let* ((conversion-constant (/ (atan 1 1) 45)) - (complex (make-polar - radius - (* conversion-constant angle-in-degrees)))) - (cons - (real-part complex) - (imag-part complex)))) + (ly:stencil-add stencil stroke))) (define (buildflag flag-stencil remain curr-stencil spacing) + "Internal function to recursively create a stencil with @code{remain} flags + from the single-flag stencil curr-stencil, which is already translated to + the position of the previous flag position." (if (> remain 0) (let* ((translated-stencil (ly:stencil-translate-axis curr-stencil spacing Y)) (new-stencil (ly:stencil-add flag-stencil translated-stencil))) @@ -41,59 +58,70 @@ flag-stencil)) (define-public (straight-flag flag-thickness flag-spacing - upflag-angle upflag-length - downflag-angle downflag-length) - "Create a stencil for a straight flag. - flag-thickness, -spacing are given in staff spaces, - *flag-angle is given in degree, - *flag-length is given in staff spaces" - (lambda (stem-grob) - (let* ((log (ly:grob-property stem-grob 'duration-log)) - (layout (ly:grob-layout stem-grob)) - (stem-up? (eqv? (ly:grob-property stem-grob 'direction) UP)) - ; scale with the note size (e.g. for grace notes). Default fontsize - ; is fs==0, each step is ~12.246% larger / smaller - (fs (ly:grob-property stem-grob 'font-size)) - (factor (if (number? fs) (expt 1.12246 fs) 1)) + upflag-angle upflag-length + downflag-angle downflag-length) + "Create a stencil for a straight flag. @var{flag-thickness} and +@var{flag-spacing} are given in staff spaces, @var{upflag-angle} and +@var{downflag-angle} are given in degrees, and @var{upflag-length} and +@var{downflag-length} are given in staff spaces. + +All lengths are scaled according to the font size of the note." + + (lambda (grob) + (let* ((stem-grob (ly:grob-parent grob X)) + (log (ly:grob-property stem-grob 'duration-log)) + (dir (ly:grob-property stem-grob 'direction)) + (stem-up (eqv? dir UP)) + (layout (ly:grob-layout grob)) + ;; scale with the note size (e.g. for grace notes) + (factor (magstep (ly:grob-property grob 'font-size 0))) (grob-stem-thickness (ly:grob-property stem-grob 'thickness)) (line-thickness (ly:output-def-lookup layout 'line-thickness)) (half-stem-thickness (/ (* grob-stem-thickness line-thickness) 2)) - (up-length (+ (* upflag-length factor) half-stem-thickness)) - (up-off (polar->rectangular up-length upflag-angle)) - (down-length (+ (* downflag-length factor) half-stem-thickness)) - (down-off (polar->rectangular down-length downflag-angle)) + (raw-length (if stem-up upflag-length downflag-length)) + (angle (if stem-up upflag-angle downflag-angle)) + (flag-length (+ (* raw-length factor) half-stem-thickness)) + (flag-end (polar->rectangular flag-length angle)) (thickness (* flag-thickness factor)) - (offset (cons 0 (if stem-up? (- thickness) thickness))) - (spacing (* flag-spacing factor (if stem-up? -1 1))) - (start (cons (- half-stem-thickness) (if stem-up? half-stem-thickness (- half-stem-thickness)))) - (points (if stem-up? (list start up-off - (offset-add up-off offset) - (offset-add start offset)) - (list start - (offset-add start offset) - (offset-add down-off offset) - down-off))) + (thickness-offset (cons 0 (* -1 thickness dir))) + (spacing (* -1 flag-spacing factor dir )) + (start (cons (- half-stem-thickness) (* half-stem-thickness dir))) + (raw-points + (list + '(0 . 0) + flag-end + (offset-add flag-end thickness-offset) + thickness-offset)) + (points (map (lambda (coord) (offset-add coord start)) raw-points)) (stencil (ly:round-filled-polygon points half-stem-thickness)) - ; Log for 1/8 is 3, so we need to subtract 3 + ;; Log for 1/8 is 3, so we need to subtract 3 (flag-stencil (buildflag stencil (- log 3) stencil spacing)) - (stroke-style (ly:grob-property stem-grob 'stroke-style))) - (if (null? stroke-style) - flag-stencil - (add-stroke-straight flag-stencil stem-grob - stem-up? log - stroke-style - (if stem-up? up-off down-off) - (if stem-up? up-length down-length) - thickness - (* half-stem-thickness 2)))))) - -;; Modern straight flags: angles are not as large as in the old style -(define-public (modern-straight-flag stem-grob) - ((straight-flag 0.55 1 -18 1.1 22 1.2) stem-grob)) - -;; Old-straight flags (Bach, etc.): quite large flag angles -(define-public (old-straight-flag stem-grob) - ((straight-flag 0.55 1 -45 1.2 45 1.4) stem-grob)) + (stroke-style (ly:grob-property grob 'stroke-style))) + (cond ((eq? (ly:grob-property grob 'style) 'no-flag) + empty-stencil) + ((equal? stroke-style "grace") + (add-stroke-straight flag-stencil grob + dir log + stroke-style + flag-end flag-length + thickness + (* half-stem-thickness 2))) + (else flag-stencil))))) + +(define-public (modern-straight-flag grob) + "Modern straight flag style (for composers like Stockhausen, Boulez, etc.). +The angles are 18 and 22 degrees and thus smaller than for the ancient style +of Bach, etc." + ((straight-flag 0.55 1 -18 1.1 22 1.2) grob)) + +(define-public (old-straight-flag grob) + "Old straight flag style (for composers like Bach). The angles of the +flags are both 45 degrees." + ((straight-flag 0.55 1 -45 1.2 45 1.4) grob)) + +(define-public (flat-flag grob) + "Flat flag style. The angles of the flags are both 0 degrees" + ((straight-flag 0.55 1.0 0 1.0 0 1.0) grob)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -101,105 +129,120 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; NOTE: By default, lilypond uses the C++ method Stem::calc-flag -; (ly:stem::calc-flag is the corresponding Scheme interface) to generate the -; flag stencil. The following functions are simply a reimplementation in -; Scheme, so that one has that functionality available in Scheme, if one -; wants to write a flag style, which modifies one of the standard flags -; by some stencil operations. +;; NOTE: By default, lilypond uses the C++ method Flag::stencil +;; (ly:flag::stencil is the corresponding Scheme interface) to generate the +;; flag stencil. The following functions are simply a reimplementation in +;; Scheme, so that one has that functionality available in Scheme, if one +;; wants to write a flag style, which modifies one of the standard flags +;; by some stencil operations. -(define-public (add-stroke-glyph stencil stem-grob dir stroke-style flag-style) +(define-public (add-stroke-glyph stencil grob dir stroke-style flag-style) "Load and add a stroke (represented by a glyph in the font) to the given - flag stencil" +flag stencil." (if (not (string? stroke-style)) - stencil - ; Otherwise: look up the stroke glyph and combine it with the flag - (let* ((font-char (string-append "flags." flag-style dir stroke-style)) - (alt-font-char (string-append "flags." dir stroke-style)) - (font (ly:grob-default-font stem-grob)) - (tmpstencil (ly:font-get-glyph font font-char)) - (stroke-stencil (if (ly:stencil-empty? tmpstencil) - (ly:font-get-glyph font alt-font-char) - tmpstencil))) - (if (ly:stencil-empty? stroke-stencil) - (begin - (ly:warning (_ "flag stroke `~a' or `~a' not found") font-char alt-font-char) - stencil) - (ly:stencil-add stencil stroke-stencil))))) - - -(define-public (retrieve-glyph-flag flag-style dir dir-modifier stem-grob) - "Load the correct flag glyph from the font" - (let* ((log (ly:grob-property stem-grob 'duration-log)) - (font (ly:grob-default-font stem-grob)) + stencil + ;; Otherwise: look up the stroke glyph and combine it with the flag + (let* ((stem-grob (ly:grob-parent grob X)) + (font-char (string-append "flags." flag-style dir stroke-style)) + (alt-font-char (string-append "flags." dir stroke-style)) + (font (ly:grob-default-font grob)) + (tmpstencil (ly:font-get-glyph font font-char)) + (stroke-stencil (if (ly:stencil-empty? tmpstencil) + (ly:font-get-glyph font alt-font-char) + tmpstencil))) + (if (ly:stencil-empty? stroke-stencil) + (begin + (ly:warning (_ "flag stroke `~a' or `~a' not found") font-char alt-font-char) + stencil) + (ly:stencil-add stencil stroke-stencil))))) + + +(define-public (retrieve-glyph-flag flag-style dir dir-modifier grob) + "Load the correct flag glyph from the font." + (let* ((stem-grob (ly:grob-parent grob X)) + (log (ly:grob-property stem-grob 'duration-log)) + (font (ly:grob-default-font grob)) (font-char (string-append "flags." flag-style dir dir-modifier (number->string log))) (flag (ly:font-get-glyph font font-char))) (if (ly:stencil-empty? flag) - (ly:warning "flag ~a not found" font-char)) + (ly:warning "flag ~a not found" font-char)) flag)) -(define-public (create-glyph-flag flag-style dir-modifier stem-grob) - "Create a flag stencil by looking up the glyph from the font" - (let* ((dir (if (eqv? (ly:grob-property stem-grob 'direction) UP) "u" "d")) - (flag (retrieve-glyph-flag flag-style dir dir-modifier stem-grob)) - (stroke-style (ly:grob-property stem-grob 'stroke-style))) - (if (null? stroke-style) - flag - (add-stroke-glyph flag stem-grob dir stroke-style flag-style)))) +(define-public (create-glyph-flag flag-style dir-modifier grob) + "Create a flag stencil by looking up the glyph from the font." + (let* ((stem-grob (ly:grob-parent grob X)) + (dir (if (eqv? (ly:grob-property stem-grob 'direction) UP) "u" "d")) + (flag (retrieve-glyph-flag flag-style dir dir-modifier grob)) + (stroke-style (ly:grob-property grob 'stroke-style))) + (cond ((eq? (ly:grob-property grob 'style) 'no-flag) + empty-stencil) + ((null? stroke-style) + flag) + (else + (add-stroke-glyph flag grob dir stroke-style flag-style))))) - -(define-public (mensural-flag stem-grob) +(define-public (mensural-flag grob) "Mensural flags: Create the flag stencil by loading the glyph from the font. - Flags are always aligned with staff lines, so we need to check the end point - of the stem: For stems ending on staff lines, use different flags than for - notes between staff lines. The idea is that flags are always vertically - aligned with the staff lines, regardless of whether the note head is on a - staff line or between two staff lines. In other words, the inner end of - a flag always touches a staff line." - - (let* ((adjust #t) - (stem-end (inexact->exact (round (ly:grob-property stem-grob 'stem-end-position)))) - ; For some reason the stem-end is a real instead of an integer... +Flags are always aligned with staff lines, so we need to check the end point +of the stem: For stems ending on staff lines, use different flags than for +notes between staff lines. The idea is that flags are always vertically +aligned with the staff lines, regardless of whether the note head is on a +staff line or between two staff lines. In other words, the inner end of +a flag always touches a staff line." + + (let* ((stem-grob (ly:grob-parent grob X)) + (adjust #t) + (d (ly:grob-property stem-grob 'direction)) + (ss (ly:staff-symbol-staff-space stem-grob)) + (stem-end (inexact->exact (round (* (index-cell + (ly:grob-extent stem-grob + stem-grob + Y) + d) + (/ 2 ss))))) + ;; For some reason the stem-end is a real instead of an integer... (dir-modifier (if (ly:position-on-line? stem-grob stem-end) "1" "0")) (modifier (if adjust dir-modifier "2"))) - (create-glyph-flag "mensural" modifier stem-grob))) - + (create-glyph-flag "mensural" modifier grob))) -(define-public ((glyph-flag flag-style) stem-grob) - "Simulates the default way of generating flags: look up glyphs - flags.style[ud][1234] from the feta font and use it for the flag stencil." - (create-glyph-flag flag-style "" stem-grob)) +(define ((glyph-flag flag-style) grob) + "Simulatesthe default way of generating flags: Look up glyphs +@code{flags.style[ud][1234]} from the feta font and use it for the flag +stencil." + (create-glyph-flag flag-style "" grob)) +(export glyph-flag) +(define-public (normal-flag grob) + "Create a default flag." + (create-glyph-flag "" "" grob)) -(define-public (normal-flag stem-grob) - "Create a default flag" - (create-glyph-flag "" "" stem-grob)) +(define-public (default-flag grob) + "Create a flag stencil for the stem. Its style will be derived from the +@code{'style} Flag property. By default, @code{lilypond} uses a +C++ Function (which is slightly faster) to do exactly the same as this +function. However, if one wants to modify the default flags, this function +can be used to obtain the default flag stencil, which can then be modified +at will. The correct way to do this is: - -(define-public (default-flag stem-grob) - "Create a flag stencil for the stem. Its style will be derived from the - @code{'flag-style} Stem property. By default, @code{lilypond} uses a - C++ Function (which is slightly faster) to do exactly the same as this - function. However, if one wants to modify the default flags, this function - can be used to obtain the default flag stencil, which can then be modified - at will. The correct way to do this is: @example -\\override Stem #'flag = #default-flag -\\override Stem #'flag-style = #'mensural +\\override Flag #'stencil = #default-flag +\\override Flag #'style = #'mensural @end example " - (let* ((flag-style-symbol (ly:grob-property stem-grob 'flag-style)) + (let* ((stem-grob (ly:grob-parent grob X)) + (flag-style-symbol (ly:grob-property grob 'style)) (flag-style (if (symbol? flag-style-symbol) (symbol->string flag-style-symbol) ""))) (cond - ((equal? flag-style "") (normal-flag stem-grob)) - ((equal? flag-style "mensural") (mensural-flag stem-grob)) - ((equal? flag-style "no-flag") (no-flag stem-grob)) - (else ((glyph-flag flag-style) stem-grob))))) + ((equal? flag-style "") (normal-flag grob)) + ((equal? flag-style "mensural") (mensural-flag grob)) + ((equal? flag-style "no-flag") empty-stencil) + (else ((glyph-flag flag-style) grob))))) +