-;;;; flag-styles.scm
+;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; source file of the GNU LilyPOnd music typesetter
+;;;; Copyright (C) 2008--2010 Reinhold Kainhofer <reinhold@kainhofer.com>
;;;;
+;;;; 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 <http://www.gnu.org/licenses/>.
+
+;;;; This file implements different flag styles in Scheme / GUILE, most
+;;;; notably the old-straight-flag and the modern-straight-flag styles.
+
(define-public (no-flag stem-grob)
"No flag: Simply return empty stencil"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;; TODO
-;; (define-public (add-stroke-straight stencil dir stroke-style)
-;; stencil
-;; )
-;;
-;; ;; Create a stencil for a straight flag
-;; ;; flag-thickness, -spacing are given in staff spaces
-;; ;; *flag-length are given in black notehead widths
-;; ;; TODO
-;; (define-public (straight-flag flag-thickness flag-spacing
-;; upflag-angle upflag-length
-;; downflag-angle downflag-length)
-;; (lambda (stem-grob)
-;; (let* ((log (ly:grob-property stem-grob 'duration-log))
-;; (staff-space 1) ; TODO
-;; (black-notehead-width 1) ; TODO
-;; (stem-thickness 1) ; TODO: get rid of
-;; (half-stem-thickness (/ stem-thickness 2))
-;; (staff-space 1) ; TODO
-;; (up-length (+ (* upflag-length black-notehead-width) half-stem-thickness))
-;; (down-length (+ (* downflag-length black-notehead-width) half-stem-thickness))
-;; (thickness (* flag-thickness staff-space))
-;; (spacing (* flag-spacing staff-space)))
-;; empty-stencil
-;; )
-;; )
-;; )
-;;
-;; ;; Modern straight flags: angles are not so large as with the old style
-;; (define-public (modern-straight-flag stem-grob)
-;; ((straight-flag 0.55 0.9 -18 0.95 22 1.0) stem-grob))
-;;
-;; ;; Old-straight flags (Bach, etc.): quite large flag angles
-;; (define-public (old-straight-flag stem-grob)
-;; ((straight-flag 0.55 0.9 -45 0.95 45 1.0) stem-grob))
+(define-public (add-stroke-straight stencil stem-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* ((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 (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)))
+ (buildflag new-stencil (- remain 1) translated-stencil spacing))
+ 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.
+ All lengths will be scaled according to the font size of the note."
+ (lambda (stem-grob)
+ (let* ((log (ly:grob-property stem-grob 'duration-log))
+ (dir (ly:grob-property stem-grob 'direction))
+ (stem-up (eqv? dir UP))
+ (layout (ly:grob-layout stem-grob))
+ ; scale with the note size (e.g. for grace notes)
+ (factor (magstep (ly:grob-property stem-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))
+ (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))
+ (thickness-offset (cons 0 (* -1 thickness dir)))
+ (spacing (* -1 flag-spacing factor dir ))
+ (start (cons (- half-stem-thickness) (* half-stem-thickness dir)))
+ ; The points of a round-filled-polygon need to be given in clockwise
+ ; order, otherwise the polygon will be enlarged by blot-size*2!
+ (points (if stem-up (list start flag-end
+ (offset-add flag-end thickness-offset)
+ (offset-add start thickness-offset))
+ (list start
+ (offset-add start thickness-offset)
+ (offset-add flag-end thickness-offset)
+ flag-end)))
+ (stencil (ly:round-filled-polygon points half-stem-thickness))
+ ; 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 (equal? stroke-style "grace")
+ (add-stroke-straight flag-stencil stem-grob
+ dir log
+ stroke-style
+ flag-end flag-length
+ thickness
+ (* half-stem-thickness 2))
+ flag-stencil))))
+
+(define-public (modern-straight-flag stem-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) stem-grob))
+
+(define-public (old-straight-flag stem-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) stem-grob))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
tmpstencil)))
(if (ly:stencil-empty? stroke-stencil)
(begin
- (ly:warning (_ "flag stroke `~a' or `~a'not found") font-char alt-font-char)
+ (ly:warning (_ "flag stroke `~a' or `~a' not found") font-char alt-font-char)
stencil)
(ly:stencil-add stencil stroke-stencil)))))
(define-public (mensural-flag stem-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
+ 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)
(define-public (default-flag stem-grob)
- "Create a flag stencil for the stem. Its style will be derived from the
+ "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
+ 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
projects / lilypond.git / blobdiff