X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fflag-styles.scm;h=f858ac20746b5767d6608aab2fb3c89fb0693351;hb=ee0488f3aa19e0060b6e17c46a4d88cb9d57c489;hp=acdc38108fcb4d4d84cad692f8f85a72b138d80c;hpb=4199c469dd5ae15065499ef206bbc7f8ac618e75;p=lilypond.git diff --git a/scm/flag-styles.scm b/scm/flag-styles.scm index acdc38108f..f858ac2074 100644 --- a/scm/flag-styles.scm +++ b/scm/flag-styles.scm @@ -1,7 +1,23 @@ -;;;; 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 ;;;; +;;;; 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 and the modern-straight-flag styles. + (define-public (no-flag stem-grob) "No flag: Simply return empty stencil" @@ -13,41 +29,101 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; ;; 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 PI-OVER-180 (/ (atan 1 1) 45)) +(define (degrees->radians angle-degrees) + "Convert the given angle from degrees to radians" + (* angle-degrees PI-OVER-180)) + +(define (polar->rectangular radius angle-in-degrees) + "Convert polar coordinate @code{radius} and @code{angle-in-degrees} + to (x-length . y-length)" + (let* ((complex (make-polar + radius + (degrees->radians angle-in-degrees)))) + (cons + (real-part complex) + (imag-part complex)))) + +(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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;