OLD | NEW |
1 ;;;; This file is part of LilyPond, the GNU music typesetter. | 1 ;;;; This file is part of LilyPond, the GNU music typesetter. |
2 ;;;; | 2 ;;;; |
3 ;;;; Copyright (C) 1998--2020 Jan Nieuwenhuizen <janneke@gnu.org> | 3 ;;;; Copyright (C) 1998--2020 Jan Nieuwenhuizen <janneke@gnu.org> |
4 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl> | 4 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl> |
5 ;;;; | 5 ;;;; |
6 ;;;; LilyPond is free software: you can redistribute it and/or modify | 6 ;;;; LilyPond is free software: you can redistribute it and/or modify |
7 ;;;; it under the terms of the GNU General Public License as published by | 7 ;;;; it under the terms of the GNU General Public License as published by |
8 ;;;; the Free Software Foundation, either version 3 of the License, or | 8 ;;;; the Free Software Foundation, either version 3 of the License, or |
9 ;;;; (at your option) any later version. | 9 ;;;; (at your option) any later version. |
10 ;;;; | 10 ;;;; |
(...skipping 128 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
139 (pointer-props | 139 (pointer-props |
140 (filter | 140 (filter |
141 (lambda (prop) | 141 (lambda (prop) |
142 (let ((type (object-property prop 'backend-type?))) | 142 (let ((type (object-property prop 'backend-type?))) |
143 (or (eq? type ly:grob?) | 143 (or (eq? type ly:grob?) |
144 (eq? type ly:grob-array?)))) | 144 (eq? type ly:grob-array?)))) |
145 props))) | 145 props))) |
146 (if (null? pointer-props) | 146 (if (null? pointer-props) |
147 '() | 147 '() |
148 (list iface | 148 (list iface |
149 (map | 149 (map |
150 (lambda (prop) (list prop (ly:grob-object grob prop))) | 150 (lambda (prop) (list prop (ly:grob-object grob prop))) |
151 pointer-props))))) | 151 pointer-props))))) |
152 | 152 |
153 (define-public (grob::all-objects grob) | 153 (define-public (grob::all-objects grob) |
154 "Return a list of the names and contents of all properties having type | 154 "Return a list of the names and contents of all properties having type |
155 @code{ly:grob?} or @code{ly:grob-array?} for all interfaces supported by | 155 @code{ly:grob?} or @code{ly:grob-array?} for all interfaces supported by |
156 grob @var{grob}." | 156 grob @var{grob}." |
157 (let loop ((ifaces (ly:grob-interfaces grob)) (result '())) | 157 (let loop ((ifaces (ly:grob-interfaces grob)) (result '())) |
158 (if (null? ifaces) | 158 (if (null? ifaces) |
159 (cons grob (list result)) | 159 (cons grob (list result)) |
160 (let ((entry (grob::objects-from-interface grob (car ifaces)))) | 160 (let ((entry (grob::objects-from-interface grob (car ifaces)))) |
161 (if (pair? entry) | 161 (if (pair? entry) |
(...skipping 507 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
669 | 669 |
670 (if txt | 670 (if txt |
671 (make-line-markup | 671 (make-line-markup |
672 (list txt (make-fontsize-markup -5 (make-note-markup note UP)))) | 672 (list txt (make-fontsize-markup -5 (make-note-markup note UP)))) |
673 (make-fontsize-markup -5 (make-note-markup note UP))))) | 673 (make-fontsize-markup -5 (make-note-markup note UP))))) |
674 (export tuplet-number::append-note-wrapper) | 674 (export tuplet-number::append-note-wrapper) |
675 | 675 |
676 ;; Print a tuplet denominator with a different number than the one derived from | 676 ;; Print a tuplet denominator with a different number than the one derived from |
677 ;; the actual tuplet fraction | 677 ;; the actual tuplet fraction |
678 (define ((tuplet-number::non-default-tuplet-denominator-text denominator) | 678 (define ((tuplet-number::non-default-tuplet-denominator-text denominator) |
679 grob) | 679 grob) |
680 (number->string (if denominator | 680 (number->string (if denominator |
681 denominator | 681 denominator |
682 (ly:event-property (event-cause grob) 'denominator)))) | 682 (ly:event-property (event-cause grob) 'denominator)))) |
683 (export tuplet-number::non-default-tuplet-denominator-text) | 683 (export tuplet-number::non-default-tuplet-denominator-text) |
684 | 684 |
685 ;; Print a tuplet fraction with different numbers than the ones derived from | 685 ;; Print a tuplet fraction with different numbers than the ones derived from |
686 ;; the actual tuplet fraction | 686 ;; the actual tuplet fraction |
687 (define ((tuplet-number::non-default-tuplet-fraction-text | 687 (define ((tuplet-number::non-default-tuplet-fraction-text |
688 denominator numerator) grob) | 688 denominator numerator) grob) |
689 (let* ((ev (event-cause grob)) | 689 (let* ((ev (event-cause grob)) |
690 (den (if denominator denominator (ly:event-property ev 'denominator))) | 690 (den (if denominator denominator (ly:event-property ev 'denominator))) |
691 (num (if numerator numerator (ly:event-property ev 'numerator)))) | 691 (num (if numerator numerator (ly:event-property ev 'numerator)))) |
692 | 692 |
693 (format #f "~a:~a" den num))) | 693 (format #f "~a:~a" den num))) |
694 (export tuplet-number::non-default-tuplet-fraction-text) | 694 (export tuplet-number::non-default-tuplet-fraction-text) |
695 | 695 |
696 ;; Print a tuplet fraction with note durations appended to the numerator and the | 696 ;; Print a tuplet fraction with note durations appended to the numerator and the |
697 ;; denominator | 697 ;; denominator |
698 (define ((tuplet-number::fraction-with-notes | 698 (define ((tuplet-number::fraction-with-notes |
699 denominatornote numeratornote) grob) | 699 denominatornote numeratornote) grob) |
700 (let* ((ev (event-cause grob)) | 700 (let* ((ev (event-cause grob)) |
701 (denominator (ly:event-property ev 'denominator)) | 701 (denominator (ly:event-property ev 'denominator)) |
702 (numerator (ly:event-property ev 'numerator))) | 702 (numerator (ly:event-property ev 'numerator))) |
703 | 703 |
704 ((tuplet-number::non-default-fraction-with-notes | 704 ((tuplet-number::non-default-fraction-with-notes |
705 denominator denominatornote numerator numeratornote) grob))) | 705 denominator denominatornote numerator numeratornote) grob))) |
706 (export tuplet-number::fraction-with-notes) | 706 (export tuplet-number::fraction-with-notes) |
707 | 707 |
708 ;; Print a tuplet fraction with note durations appended to the numerator and the | 708 ;; Print a tuplet fraction with note durations appended to the numerator and the |
709 ;; denominator | 709 ;; denominator |
710 (define ((tuplet-number::non-default-fraction-with-notes | 710 (define ((tuplet-number::non-default-fraction-with-notes |
711 denominator denominatornote numerator numeratornote) grob) | 711 denominator denominatornote numerator numeratornote) grob) |
712 (let* ((ev (event-cause grob)) | 712 (let* ((ev (event-cause grob)) |
713 (den (if denominator denominator (ly:event-property ev 'denominator))) | 713 (den (if denominator denominator (ly:event-property ev 'denominator))) |
714 (num (if numerator numerator (ly:event-property ev 'numerator)))) | 714 (num (if numerator numerator (ly:event-property ev 'numerator)))) |
715 | 715 |
716 (make-concat-markup (list | 716 (make-concat-markup (list |
717 (make-simple-markup (format #f "~a" den)) | 717 (make-simple-markup (format #f "~a" den)) |
718 (make-fontsize-markup -5 (make-note-markup denominatorn
ote UP)) | 718 (make-fontsize-markup -5 (make-note-markup denominatorn
ote UP)) |
719 (make-simple-markup " : ") | 719 (make-simple-markup " : ") |
720 (make-simple-markup (format #f "~a" num)) | 720 (make-simple-markup (format #f "~a" num)) |
721 (make-fontsize-markup -5 (make-note-markup numeratornot
e UP)))))) | 721 (make-fontsize-markup -5 (make-note-markup numeratornot
e UP)))))) |
(...skipping 54 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
776 min-position) | 776 min-position) |
777 7) | 777 7) |
778 min-position))) | 778 min-position))) |
779 (define (prepend x l) (if (> x max-position) | 779 (define (prepend x l) (if (> x max-position) |
780 l | 780 l |
781 (prepend (+ x 7) (cons x l)))) | 781 (prepend (+ x 7) (cons x l)))) |
782 (prepend first-position '()))))) | 782 (prepend first-position '()))))) |
783 | 783 |
784 (define-public (key-signature-interface::alteration-position | 784 (define-public (key-signature-interface::alteration-position |
785 step alter c0-position) | 785 step alter c0-position) |
786 ;; Deprecated. Not a documented interface, and no longer used in LilyPond, | 786 ;; Deprecated. Not a documented interface, and no longer used in LilyPond, |
787 ;; but needed for a popular file, LilyJAZZ.ily for version 2.16 | 787 ;; but needed for a popular file, LilyJAZZ.ily for version 2.16 |
788 (if (pair? step) | 788 (if (pair? step) |
789 (+ (cdr step) (* (car step) 7) c0-position) | 789 (+ (cdr step) (* (car step) 7) c0-position) |
790 (let* ((c-pos (modulo c0-position 7)) | 790 (let* ((c-pos (modulo c0-position 7)) |
791 (hi (list-ref | 791 (hi (list-ref |
792 (if (< alter 0) | 792 (if (< alter 0) |
793 '(2 3 4 2 1 2 1) ; position of highest flat | 793 '(2 3 4 2 1 2 1) ; position of highest flat |
794 '(4 5 4 2 3 2 3)); position of highest sharp | 794 '(4 5 4 2 3 2 3)); position of highest sharp |
795 c-pos))) | 795 c-pos))) |
796 (- hi (modulo (- hi (+ c-pos step)) 7))))) | 796 (- hi (modulo (- hi (+ c-pos step)) 7))))) |
797 | 797 |
798 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 798 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
799 ;; annotations | 799 ;; annotations |
800 | 800 |
801 (define-public (numbered-footnotes int) | 801 (define-public (numbered-footnotes int) |
802 (make-tiny-markup (number->string (+ 1 int)))) | 802 (make-tiny-markup (number->string (+ 1 int)))) |
803 | 803 |
804 (define-public (symbol-footnotes int) | 804 (define-public (symbol-footnotes int) |
805 (define (helper symbols out idx n) | 805 (define (helper symbols out idx n) |
806 (if (< n 1) | 806 (if (< n 1) |
(...skipping 130 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
937 (stencil-whiteout-box rp)))) | 937 (stencil-whiteout-box rp)))) |
938 | 938 |
939 (define-public (parentheses-item::y-extent grob) (ly:grob::stencil-height grob)) | 939 (define-public (parentheses-item::y-extent grob) (ly:grob::stencil-height grob)) |
940 | 940 |
941 (define (parenthesize-elements grob . rest) | 941 (define (parenthesize-elements grob . rest) |
942 (let* ((refp (if (null? rest) | 942 (let* ((refp (if (null? rest) |
943 grob | 943 grob |
944 (car rest))) | 944 (car rest))) |
945 (elts (ly:grob-array->list (ly:grob-object grob 'elements))) | 945 (elts (ly:grob-array->list (ly:grob-object grob 'elements))) |
946 (get-friends | 946 (get-friends |
947 (lambda (g) | 947 (lambda (g) |
948 (let ((syms (ly:grob-property g 'parenthesis-friends '())) | 948 (let ((syms (ly:grob-property g 'parenthesis-friends '())) |
949 (get-friend (lambda (s) | 949 (get-friend (lambda (s) |
950 (let ((f (ly:grob-object g s))) | 950 (let ((f (ly:grob-object g s))) |
951 (cond | 951 (cond |
952 ((ly:grob? f) (list f)) | 952 ((ly:grob? f) (list f)) |
953 ((ly:grob-array? f) (ly:grob-array->list f)
) | 953 ((ly:grob-array? f) (ly:grob-array->list f)) |
954 (else '())))))) | 954 (else '())))))) |
955 (apply append (map get-friend syms))))) | 955 (apply append (map get-friend syms))))) |
956 (friends (apply append elts (map get-friends elts))) | 956 (friends (apply append elts (map get-friends elts))) |
957 (x-ext (ly:relative-group-extent friends refp X)) | 957 (x-ext (ly:relative-group-extent friends refp X)) |
958 (stencils (ly:grob-property grob 'stencils)) | 958 (stencils (ly:grob-property grob 'stencils)) |
959 (lp (car stencils)) | 959 (lp (car stencils)) |
960 (rp (cadr stencils)) | 960 (rp (cadr stencils)) |
961 (padding (ly:grob-property grob 'padding 0.1))) | 961 (padding (ly:grob-property grob 'padding 0.1))) |
962 | 962 |
963 (ly:stencil-add | 963 (ly:stencil-add |
964 (ly:stencil-translate-axis lp (- (car x-ext) padding) X) | 964 (ly:stencil-translate-axis lp (- (car x-ext) padding) X) |
965 (ly:stencil-translate-axis rp (+ (cdr x-ext) padding) X)))) | 965 (ly:stencil-translate-axis rp (+ (cdr x-ext) padding) X)))) |
(...skipping 19 matching lines...) Expand all Loading... |
985 | 985 |
986 (define-public (pure-chain-offset-callback grob start end prev-offset) | 986 (define-public (pure-chain-offset-callback grob start end prev-offset) |
987 "Sometimes, a chained offset callback is unpure and there is | 987 "Sometimes, a chained offset callback is unpure and there is |
988 no way to write a pure function that estimates its behavior. | 988 no way to write a pure function that estimates its behavior. |
989 In this case, we use a pure equivalent that will simply pass | 989 In this case, we use a pure equivalent that will simply pass |
990 the previous calculated offset value." | 990 the previous calculated offset value." |
991 prev-offset) | 991 prev-offset) |
992 | 992 |
993 (define-public (scale-by-font-size x) | 993 (define-public (scale-by-font-size x) |
994 (ly:make-unpure-pure-container | 994 (ly:make-unpure-pure-container |
995 (lambda (grob) | 995 (lambda (grob) |
996 (* x (magstep (ly:grob-property grob 'font-size 0)))))) | 996 (* x (magstep (ly:grob-property grob 'font-size 0)))))) |
997 | 997 |
998 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 998 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
999 ;; | 999 ;; |
1000 | 1000 |
1001 (define-public (grob::compose-function func data) | 1001 (define-public (grob::compose-function func data) |
1002 "This creates a callback entity to be stored in a grob property, | 1002 "This creates a callback entity to be stored in a grob property, |
1003 based on the grob property data @var{data} (which can be plain data, a | 1003 based on the grob property data @var{data} (which can be plain data, a |
1004 callback itself, or an unpure-pure-container). | 1004 callback itself, or an unpure-pure-container). |
1005 | 1005 |
1006 Function or unpure-pure-container @var{func} accepts a grob and a | 1006 Function or unpure-pure-container @var{func} accepts a grob and a |
(...skipping 184 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
1191 (+ my-padding script-padding))))))) | 1191 (+ my-padding script-padding))))))) |
1192 | 1192 |
1193 (define-public (make-connected-line points grob) | 1193 (define-public (make-connected-line points grob) |
1194 "Takes a list of points, @var{points}. | 1194 "Takes a list of points, @var{points}. |
1195 Returns a line connecting @var{points}, using @code{ly:line-interface::line}, | 1195 Returns a line connecting @var{points}, using @code{ly:line-interface::line}, |
1196 gets layout information from @var{grob}" | 1196 gets layout information from @var{grob}" |
1197 (define (connected-points grob ls pts) | 1197 (define (connected-points grob ls pts) |
1198 (if (not (pair? (cdr pts))) | 1198 (if (not (pair? (cdr pts))) |
1199 (reduce ly:stencil-add empty-stencil ls) | 1199 (reduce ly:stencil-add empty-stencil ls) |
1200 (connected-points | 1200 (connected-points |
1201 grob | 1201 grob |
1202 (cons | 1202 (cons |
1203 (ly:line-interface::line | 1203 (ly:line-interface::line |
1204 grob | 1204 grob |
1205 (car (first pts)) | 1205 (car (first pts)) |
1206 (cdr (first pts)) | 1206 (cdr (first pts)) |
1207 (car (second pts)) | 1207 (car (second pts)) |
1208 (cdr (second pts))) | 1208 (cdr (second pts))) |
1209 ls) | 1209 ls) |
1210 (cdr pts)))) | 1210 (cdr pts)))) |
1211 (if (< (length points) 2) | 1211 (if (< (length points) 2) |
1212 (begin | 1212 (begin |
1213 (ly:warning | 1213 (ly:warning |
1214 "´make-connected-line´ needs at least two points: ~a" | 1214 "´make-connected-line´ needs at least two points: ~a" |
1215 points) | 1215 points) |
1216 empty-stencil) | 1216 empty-stencil) |
1217 (connected-points grob '() points))) | 1217 (connected-points grob '() points))) |
1218 | 1218 |
1219 (define ((elbowed-hairpin coords mirrored?) grob) | 1219 (define ((elbowed-hairpin coords mirrored?) grob) |
1220 "Create hairpin based on a list of @var{coords} in @code{(cons x y)} | 1220 "Create hairpin based on a list of @var{coords} in @code{(cons x y)} |
1221 form. @code{x} is the portion of the width consumed for a given line | 1221 form. @code{x} is the portion of the width consumed for a given line |
1222 and @code{y} is the portion of the height. For example, | 1222 and @code{y} is the portion of the height. For example, |
1223 @code{'((0 . 0) (0.3 . 0.7) (0.8 . 0.9) (1.0 . 1.0))} means that at the point | 1223 @code{'((0 . 0) (0.3 . 0.7) (0.8 . 0.9) (1.0 . 1.0))} means that at the point |
1224 where the hairpin has consumed 30% of its width, it must | 1224 where the hairpin has consumed 30% of its width, it must |
1225 be at 70% of its height. Once it is to 80% width, it | 1225 be at 70% of its height. Once it is to 80% width, it |
(...skipping 11 matching lines...) Expand all Loading... |
1237 (elbowed-hairpin '((0 . 0)(1.0 . 1.0)) #t)) | 1237 (elbowed-hairpin '((0 . 0)(1.0 . 1.0)) #t)) |
1238 | 1238 |
1239 \\relative c' { | 1239 \\relative c' { |
1240 \\override Hairpin #'stencil = #simple-hairpin | 1240 \\override Hairpin #'stencil = #simple-hairpin |
1241 a\\p\\< a a a\\f | 1241 a\\p\\< a a a\\f |
1242 } | 1242 } |
1243 @end lilypond | 1243 @end lilypond |
1244 " | 1244 " |
1245 (define (scale-coords coords-list x y) | 1245 (define (scale-coords coords-list x y) |
1246 (map | 1246 (map |
1247 (lambda (coord) (cons (* x (car coord)) (* y (cdr coord)))) | 1247 (lambda (coord) (cons (* x (car coord)) (* y (cdr coord)))) |
1248 coords-list)) | 1248 coords-list)) |
1249 | 1249 |
1250 (define (hairpin::print-part points decresc? me) | 1250 (define (hairpin::print-part points decresc? me) |
1251 (let ((stil (make-connected-line points me))) | 1251 (let ((stil (make-connected-line points me))) |
1252 (if decresc? (ly:stencil-scale stil -1 1) stil))) | 1252 (if decresc? (ly:stencil-scale stil -1 1) stil))) |
1253 | 1253 |
1254 ;; outer let to trigger suicide | 1254 ;; outer let to trigger suicide |
1255 (let ((sten (ly:hairpin::print grob))) | 1255 (let ((sten (ly:hairpin::print grob))) |
1256 (if (grob::is-live? grob) | 1256 (if (grob::is-live? grob) |
1257 (let* ((decresc? (eqv? (ly:grob-property grob 'grow-direction) LEFT)) | 1257 (let* ((decresc? (eqv? (ly:grob-property grob 'grow-direction) LEFT)) |
1258 (xex (ly:stencil-extent sten X)) | 1258 (xex (ly:stencil-extent sten X)) |
1259 (lenx (interval-length xex)) | 1259 (lenx (interval-length xex)) |
1260 (yex (ly:stencil-extent sten Y)) | 1260 (yex (ly:stencil-extent sten Y)) |
1261 (leny (interval-length yex)) | 1261 (leny (interval-length yex)) |
1262 (xtrans (+ (car xex) (if decresc? lenx 0))) | 1262 (xtrans (+ (car xex) (if decresc? lenx 0))) |
1263 (ytrans (car yex)) | 1263 (ytrans (car yex)) |
1264 (uplist (scale-coords coords lenx (/ leny 2))) | 1264 (uplist (scale-coords coords lenx (/ leny 2))) |
1265 (downlist (scale-coords coords lenx (/ leny -2))) | 1265 (downlist (scale-coords coords lenx (/ leny -2))) |
1266 (stil | 1266 (stil |
1267 (ly:stencil-aligned-to | 1267 (ly:stencil-aligned-to |
1268 (ly:stencil-translate | 1268 (ly:stencil-translate |
1269 (ly:stencil-add | 1269 (ly:stencil-add |
1270 (hairpin::print-part uplist decresc? grob) | 1270 (hairpin::print-part uplist decresc? grob) |
1271 (if mirrored? | 1271 (if mirrored? |
1272 (hairpin::print-part downlist decresc? grob) | 1272 (hairpin::print-part downlist decresc? grob) |
1273 empty-stencil)) | 1273 empty-stencil)) |
1274 (cons xtrans ytrans)) | 1274 (cons xtrans ytrans)) |
1275 Y CENTER)) | 1275 Y CENTER)) |
1276 (stil-y-extent (ly:stencil-extent stil Y))) | 1276 (stil-y-extent (ly:stencil-extent stil Y))) |
1277 ;; Return a final stencil properly aligned in Y-axis direction and with | 1277 ;; Return a final stencil properly aligned in Y-axis direction and wit
h |
1278 ;; proper extents. Otherwise stencil-operations like 'box-stencil' will | 1278 ;; proper extents. Otherwise stencil-operations like 'box-stencil' wil
l |
1279 ;; return badly. Extent in X-axis direction is taken from the original, | 1279 ;; return badly. Extent in X-axis direction is taken from the original
, |
1280 ;; in Y-axis direction from the new stencil. | 1280 ;; in Y-axis direction from the new stencil. |
1281 (ly:make-stencil (ly:stencil-expr stil) xex stil-y-extent)) | 1281 (ly:make-stencil (ly:stencil-expr stil) xex stil-y-extent)) |
1282 ;; return empty, if no Hairpin.stencil present. | 1282 ;; return empty, if no Hairpin.stencil present. |
1283 '()))) | 1283 '()))) |
1284 (export elbowed-hairpin) | 1284 (export elbowed-hairpin) |
1285 | 1285 |
1286 (define-public flared-hairpin | 1286 (define-public flared-hairpin |
1287 (elbowed-hairpin '((0 . 0) (0.95 . 0.4) (1.0 . 1.0)) #t)) | 1287 (elbowed-hairpin '((0 . 0) (0.95 . 0.4) (1.0 . 1.0)) #t)) |
1288 | 1288 |
1289 (define-public constante-hairpin | 1289 (define-public constante-hairpin |
1290 (elbowed-hairpin '((0 . 0) (1.0 . 0.0) (1.0 . 1.0)) #f)) | 1290 (elbowed-hairpin '((0 . 0) (1.0 . 0.0) (1.0 . 1.0)) #f)) |
1291 | 1291 |
(...skipping 48 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
1340 | 1340 |
1341 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 1341 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
1342 ;; scripts | 1342 ;; scripts |
1343 | 1343 |
1344 (define-public (script-interface::calc-x-offset grob) | 1344 (define-public (script-interface::calc-x-offset grob) |
1345 (ly:grob-property grob 'positioning-done) | 1345 (ly:grob-property grob 'positioning-done) |
1346 (let* ((shift-when-alone (ly:grob-property grob 'toward-stem-shift 0.0)) | 1346 (let* ((shift-when-alone (ly:grob-property grob 'toward-stem-shift 0.0)) |
1347 (shift-in-column (ly:grob-property grob 'toward-stem-shift-in-column)) | 1347 (shift-in-column (ly:grob-property grob 'toward-stem-shift-in-column)) |
1348 (script-column (ly:grob-object grob 'script-column)) | 1348 (script-column (ly:grob-object grob 'script-column)) |
1349 (shift | 1349 (shift |
1350 (if (and (ly:grob? script-column) | 1350 (if (and (ly:grob? script-column) |
1351 (number? shift-in-column) | 1351 (number? shift-in-column) |
1352 ;; ScriptColumn can contain grobs other than Script. | 1352 ;; ScriptColumn can contain grobs other than Script. |
1353 ;; These should not result in a shift. | 1353 ;; These should not result in a shift. |
1354 (any (lambda (s) | 1354 (any (lambda (s) |
1355 (and (not (eq? s grob)) | 1355 (and (not (eq? s grob)) |
1356 (grob::has-interface s 'script-interface) | 1356 (grob::has-interface s 'script-interface) |
1357 (not (grob::has-interface s | 1357 (not (grob::has-interface s |
1358 'accidental-suggestion-interface)))) | 1358 'accidental-suggestion-
interface)))) |
1359 (ly:grob-array->list | 1359 (ly:grob-array->list |
1360 (ly:grob-object script-column 'scripts)))) | 1360 (ly:grob-object script-column 'scripts)))) |
1361 shift-in-column shift-when-alone)) | 1361 shift-in-column shift-when-alone)) |
1362 (note-head-location | 1362 (note-head-location |
1363 (ly:self-alignment-interface::aligned-on-x-parent grob)) | 1363 (ly:self-alignment-interface::aligned-on-x-parent grob)) |
1364 (note-head-grob (ly:grob-parent grob X)) | 1364 (note-head-grob (ly:grob-parent grob X)) |
1365 (stem-grob (ly:grob-object note-head-grob 'stem))) | 1365 (stem-grob (ly:grob-object note-head-grob 'stem))) |
1366 | 1366 |
1367 (+ note-head-location | 1367 (+ note-head-location |
1368 ;; If the script has the same direction as the stem, move the script | 1368 ;; If the script has the same direction as the stem, move the script |
1369 ;; in accordance with the value of 'shift'. Since scripts can also be | 1369 ;; in accordance with the value of 'shift'. Since scripts can also be |
1370 ;; over skips, we need to check whether the grob has a stem at all. | 1370 ;; over skips, we need to check whether the grob has a stem at all. |
1371 (if (ly:grob? stem-grob) | 1371 (if (ly:grob? stem-grob) |
(...skipping 107 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
1479 ;; ambitus | 1479 ;; ambitus |
1480 | 1480 |
1481 ;; Calculate the gaps between ambitus heads and ends of ambitus line. | 1481 ;; Calculate the gaps between ambitus heads and ends of ambitus line. |
1482 ;; Start by determining desired length of the ambitus line (based on | 1482 ;; Start by determining desired length of the ambitus line (based on |
1483 ;; length-fraction property), calc gap from that and make sure that | 1483 ;; length-fraction property), calc gap from that and make sure that |
1484 ;; it doesn't exceed maximum allowed value. | 1484 ;; it doesn't exceed maximum allowed value. |
1485 | 1485 |
1486 (define-public (ambitus-line::calc-gap grob) | 1486 (define-public (ambitus-line::calc-gap grob) |
1487 (let ((heads (ly:grob-object grob 'note-heads))) | 1487 (let ((heads (ly:grob-object grob 'note-heads))) |
1488 | 1488 |
1489 (if (and (ly:grob-array? heads) | 1489 (if (and (ly:grob-array? heads) |
1490 (= (ly:grob-array-length heads) 2)) | 1490 (= (ly:grob-array-length heads) 2)) |
1491 (let* ((common (ly:grob-common-refpoint-of-array grob heads Y)) | 1491 (let* ((common (ly:grob-common-refpoint-of-array grob heads Y)) |
1492 (head-down (ly:grob-array-ref heads 0)) | 1492 (head-down (ly:grob-array-ref heads 0)) |
1493 (head-up (ly:grob-array-ref heads 1)) | 1493 (head-up (ly:grob-array-ref heads 1)) |
1494 (fraction (ly:grob-property grob 'length-fraction 0.7)) | 1494 (fraction (ly:grob-property grob 'length-fraction 0.7)) |
1495 (max-gap (ly:grob-property grob 'maximum-gap 0.45)) | 1495 (max-gap (ly:grob-property grob 'maximum-gap 0.45)) |
1496 ;; distance between noteheads: | 1496 ;; distance between noteheads: |
1497 (distance (- (interval-start (ly:grob-extent head-up common Y)) | 1497 (distance (- (interval-start (ly:grob-extent head-up common Y)) |
1498 (interval-end (ly:grob-extent head-down common Y)))) | 1498 (interval-end (ly:grob-extent head-down common Y)))) |
1499 (gap (* 0.5 distance (- 1 fraction)))) | 1499 (gap (* 0.5 distance (- 1 fraction)))) |
1500 | 1500 |
1501 (min gap max-gap)) | 1501 (min gap max-gap)) |
1502 0))) | 1502 0))) |
1503 | 1503 |
1504 ;; Print a line connecting ambitus heads: | 1504 ;; Print a line connecting ambitus heads: |
1505 | 1505 |
1506 (define-public (ambitus::print grob) | 1506 (define-public (ambitus::print grob) |
1507 (let ((heads (ly:grob-object grob 'note-heads))) | 1507 (let ((heads (ly:grob-object grob 'note-heads))) |
1508 | 1508 |
1509 (if (and (ly:grob-array? heads) | 1509 (if (and (ly:grob-array? heads) |
1510 (= (ly:grob-array-length heads) 2)) | 1510 (= (ly:grob-array-length heads) 2)) |
1511 (let* ((common (ly:grob-common-refpoint-of-array grob heads Y)) | 1511 (let* ((common (ly:grob-common-refpoint-of-array grob heads Y)) |
1512 (head-down (ly:grob-array-ref heads 0)) | 1512 (head-down (ly:grob-array-ref heads 0)) |
(...skipping 48 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
1561 (interval-union '(0 . 0) (cons smaller larger))) | 1561 (interval-union '(0 . 0) (cons smaller larger))) |
1562 '(0 . 0)))) | 1562 '(0 . 0)))) |
1563 | 1563 |
1564 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 1564 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
1565 ;; measure counter | 1565 ;; measure counter |
1566 | 1566 |
1567 (define-public (measure-counter-stencil grob) | 1567 (define-public (measure-counter-stencil grob) |
1568 "Print a number for a measure count. Broken measures are numbered in | 1568 "Print a number for a measure count. Broken measures are numbered in |
1569 parentheses." | 1569 parentheses." |
1570 (let* ((num (make-simple-markup | 1570 (let* ((num (make-simple-markup |
1571 (number->string (ly:grob-property grob 'count-from)))) | 1571 (number->string (ly:grob-property grob 'count-from)))) |
1572 (orig (ly:grob-original grob)) | 1572 (orig (ly:grob-original grob)) |
1573 (siblings (ly:spanner-broken-into orig)) ; have we been split? | 1573 (siblings (ly:spanner-broken-into orig)) ; have we been split? |
1574 (num | 1574 (num |
1575 (if (or (null? siblings) | 1575 (if (or (null? siblings) |
1576 (eq? grob (car siblings))) | 1576 (eq? grob (car siblings))) |
1577 num | 1577 num |
1578 (make-parenthesize-markup num))) | 1578 (make-parenthesize-markup num))) |
1579 (num (grob-interpret-markup grob num)) | 1579 (num (grob-interpret-markup grob num)) |
1580 (num (ly:stencil-aligned-to | 1580 (num (ly:stencil-aligned-to |
1581 num X (ly:grob-property grob 'self-alignment-X))) | 1581 num X (ly:grob-property grob 'self-alignment-X))) |
1582 (left-bound (ly:spanner-bound grob LEFT)) | 1582 (left-bound (ly:spanner-bound grob LEFT)) |
1583 (right-bound (ly:spanner-bound grob RIGHT)) | 1583 (right-bound (ly:spanner-bound grob RIGHT)) |
1584 (refp (ly:grob-common-refpoint left-bound right-bound X)) | 1584 (refp (ly:grob-common-refpoint left-bound right-bound X)) |
1585 (spacing-pair | 1585 (spacing-pair |
1586 (ly:grob-property grob | 1586 (ly:grob-property grob |
1587 'spacing-pair | 1587 'spacing-pair |
1588 '(break-alignment . break-alignment))) | 1588 '(break-alignment . break-alignment))) |
1589 (ext-L (ly:paper-column::break-align-width left-bound | 1589 (ext-L (ly:paper-column::break-align-width left-bound |
1590 (car spacing-pair))) | 1590 (car spacing-pair))) |
1591 (ext-R (ly:paper-column::break-align-width right-bound | 1591 (ext-R (ly:paper-column::break-align-width right-bound |
1592 (cdr spacing-pair))) | 1592 (cdr spacing-pair))) |
1593 (num | 1593 (num |
1594 (ly:stencil-translate-axis | 1594 (ly:stencil-translate-axis |
1595 num | 1595 num |
1596 (+ (* 0.5 (- (car ext-R) | 1596 (+ (* 0.5 (- (car ext-R) |
1597 (cdr ext-L))) | 1597 (cdr ext-L))) |
1598 (- (cdr ext-L) | 1598 (- (cdr ext-L) |
1599 (ly:grob-relative-coordinate grob refp X))) | 1599 (ly:grob-relative-coordinate grob refp X))) |
1600 X))) | 1600 X))) |
1601 num)) | 1601 num)) |
1602 | 1602 |
1603 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 1603 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
1604 ;; HorizontalBracketText | 1604 ;; HorizontalBracketText |
1605 | 1605 |
1606 (define-public (ly:horizontal-bracket-text::print grob) | 1606 (define-public (ly:horizontal-bracket-text::print grob) |
1607 (let ((text (ly:grob-property grob 'text))) | 1607 (let ((text (ly:grob-property grob 'text))) |
1608 (if (or (null? text) | 1608 (if (or (null? text) |
1609 (equal? text "") | 1609 (equal? text "") |
1610 (equal? text empty-markup)) | 1610 (equal? text empty-markup)) |
1611 (begin | 1611 (begin |
1612 (ly:grob-suicide! grob) | 1612 (ly:grob-suicide! grob) |
1613 '()) | 1613 '()) |
1614 (let* ((orig (ly:grob-original grob)) | 1614 (let* ((orig (ly:grob-original grob)) |
1615 (siblings (ly:spanner-broken-into orig)) | 1615 (siblings (ly:spanner-broken-into orig)) |
1616 (text | 1616 (text |
1617 (if (or (null? siblings) | 1617 (if (or (null? siblings) |
1618 (eq? grob (car siblings))) | 1618 (eq? grob (car siblings))) |
1619 text | 1619 text |
1620 (if (string? text) | 1620 (if (string? text) |
1621 (string-append "(" text ")") | 1621 (string-append "(" text ")") |
1622 (make-parenthesize-markup text))))) | 1622 (make-parenthesize-markup text))))) |
1623 (grob-interpret-markup grob text))))) | 1623 (grob-interpret-markup grob text))))) |
1624 | 1624 |
1625 (define-public (ly:horizontal-bracket-text::calc-direction grob) | 1625 (define-public (ly:horizontal-bracket-text::calc-direction grob) |
1626 (let* ((bracket (ly:grob-object grob 'bracket)) | 1626 (let* ((bracket (ly:grob-object grob 'bracket)) |
1627 (bracket-dir (ly:grob-property bracket 'direction DOWN))) | 1627 (bracket-dir (ly:grob-property bracket 'direction DOWN))) |
1628 bracket-dir)) | 1628 bracket-dir)) |
1629 | 1629 |
1630 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 1630 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
1631 ;; make-engraver helper macro | 1631 ;; make-engraver helper macro |
1632 | 1632 |
(...skipping 22 matching lines...) Expand all Loading... |
1655 with the subordinate symbols being interfaces." | 1655 with the subordinate symbols being interfaces." |
1656 (let loop ((forms forms)) | 1656 (let loop ((forms forms)) |
1657 (if (or (null? forms) (pair? forms)) | 1657 (if (or (null? forms) (pair? forms)) |
1658 `(list | 1658 `(list |
1659 ,@(map (lambda (form) | 1659 ,@(map (lambda (form) |
1660 (if (pair? (car form)) | 1660 (if (pair? (car form)) |
1661 `(cons ',(caar form) (lambda ,(cdar form) ,@(cdr form))) | 1661 `(cons ',(caar form) (lambda ,(cdar form) ,@(cdr form))) |
1662 `(cons ',(car form) ,(loop (cdr form))))) | 1662 `(cons ',(car form) ,(loop (cdr form))))) |
1663 forms)) | 1663 forms)) |
1664 forms))) | 1664 forms))) |
OLD | NEW |