OLD | NEW |
(Empty) | |
| 1 ;;;; This file is part of LilyPond, the GNU music typesetter. |
| 2 ;;;; |
| 3 ;;;; Copyright (C) 2010 Mike Solomon <mikesol@stanfordalumni.org> |
| 4 ;;;; Clarinet drawings copied from diagrams created by |
| 5 ;;;; Gilles Thibault <gilles.thibault@free.fr> |
| 6 ;;;; |
| 7 ;;;; LilyPond is free software: you can redistribute it and/or modify |
| 8 ;;;; it under the terms of the GNU General Public License as published by |
| 9 ;;;; the Free Software Foundation, either version 3 of the License, or |
| 10 ;;;; (at your option) any later version. |
| 11 ;;;; |
| 12 ;;;; LilyPond is distributed in the hope that it will be useful, |
| 13 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 14 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 15 ;;;; GNU General Public License for more details. |
| 16 ;;;; |
| 17 ;;;; You should have received a copy of the GNU General Public License |
| 18 ;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>. |
| 19 |
| 20 (define HOLE-FILL-LIST '((R . 3) (1q . 5) (1h . 7) (3q . 11) (F . 13))) |
| 21 (define CENTRAL-COLUMN-HOLE-PLACEMENTS '((one . (0.0 . 6.5)) |
| 22 (two . (0.0 . 5.5)) |
| 23 (three . (0.0 . 4.5)) |
| 24 (four . (0.0 . 3.0)) |
| 25 (five . (0.0 . 2.0)) |
| 26 (six . (0.0 . 1.0)))) |
| 27 |
| 28 (define CENTRAL-COLUMN-HOLE-LIST (map car CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 29 (define CENTRAL-COLUMN-HOLE-H-LIST (cons 'h CENTRAL-COLUMN-HOLE-LIST)) |
| 30 |
| 31 ;; Utility functions |
| 32 |
| 33 (define-public (symbol-concatenate . names) |
| 34 "Like string-concatenate, but for symbols" |
| 35 (string->symbol (apply string-append (map symbol->string names)))) |
| 36 |
| 37 (define-public (function-chain arg function-list) |
| 38 "Applies a list of functions in function list to arg. |
| 39 Each element of function list is structured (cons function '(arg2 arg3 ...)) |
| 40 If function takes arguments besides arg, they are provided in function list. |
| 41 For example: |
| 42 @code{guile> (function-chain 1 `((,+ 1) (,- 2) (,+ 3) (,/)))} |
| 43 @code{1/3}" |
| 44 (if (null? function-list) |
| 45 arg |
| 46 (function-chain |
| 47 (apply (caar function-list) (append `(,arg) (cdar function-list))) |
| 48 (cdr function-list)))) |
| 49 |
| 50 (define (rotunda-map function inlist rotunda) |
| 51 "Like map, but with a rotating last argument to function. |
| 52 For example: |
| 53 @code{guile> (rotunda-map + '(1 2 3 4) '(1 -10))} |
| 54 @code{(2 -8 4 -6)}" |
| 55 (define (rotunda-map-chain function inlist outlist rotunda) |
| 56 (if (null? inlist) |
| 57 outlist |
| 58 (rotunda-map-chain |
| 59 function |
| 60 (cdr inlist) |
| 61 (append outlist (list (function (car inlist) (car rotunda)))) |
| 62 (append (cdr rotunda) (list (car rotunda)))))) |
| 63 (rotunda-map-chain function inlist '() rotunda)) |
| 64 |
| 65 (define (assoc-keys alist) |
| 66 "Gets the keys of an alist." |
| 67 (map (lambda (x) (car x)) alist)) |
| 68 |
| 69 (define (assoc-values alist) |
| 70 "Gets the values of an alist." |
| 71 (map (lambda (x) (cdr x)) alist)) |
| 72 |
| 73 (define (get-slope-offset p1 p2) |
| 74 "Gets the slope and offset for p1 and p2. |
| 75 For example: |
| 76 @code{(get-slope-offset '(1 . 2) '(3 . -5.1))} |
| 77 @code{(-3.55 . 5.55)}" |
| 78 (let* |
| 79 ((slope (/ (- (cdr p1) (cdr p2)) (- (car p1) (car p2)))) |
| 80 (offset (- (cdr p1) (* slope (car p1))))) |
| 81 `(,slope . ,offset))) |
| 82 |
| 83 (define (is-square? x input-list) |
| 84 "Returns true if x is the square of a value in input-list." |
| 85 (pair? (memv (inexact->exact (sqrt x)) input-list))) |
| 86 |
| 87 (define (satisfies-function? function input-list) |
| 88 "Returns true if an element in @code{input-list} is true |
| 89 when @code{function} is applied to it. |
| 90 For example: |
| 91 @code{guile> (satisfies-function? null? '((1 2) ()))} |
| 92 @code{#t} |
| 93 @code{guile> (satisfies-function? null? '((1 2) (3)))} |
| 94 @code{#f}" |
| 95 (if (null? input-list) |
| 96 #f |
| 97 (or (function (car input-list)) |
| 98 (satisfies-function? function (cdr input-list))))) |
| 99 |
| 100 (define (true-entry? input-list) |
| 101 "Is there a true entry in @code{input-list}?" |
| 102 (satisfies-function? identity input-list)) |
| 103 |
| 104 (define (entry-greater-than-x? input-list x) |
| 105 "Is there an entry greater than @code{x} in @code{input-list}?" |
| 106 (satisfies-function? (lambda (y) (> y x)) input-list)) |
| 107 |
| 108 (define (n-true-entries input-list) |
| 109 "Returns number of true entries in @code{input-list}." |
| 110 (reduce + 0 (map (lambda (x) (if x 1 0)) input-list))) |
| 111 |
| 112 (define (return-1 x) 1.0) |
| 113 |
| 114 (define (make-spreadsheet parameter-list) |
| 115 "Makes a spreadsheet function with columns of parameter-list. |
| 116 This function can then be filled with rows. |
| 117 For example: |
| 118 @code{guile> ((make-spreadsheet '(foo bar)) '((1 2) (3 4) (5 6)))} |
| 119 @code{(((foo . 1) (bar . 2)) ((foo . 3) (bar . 4)) ((foo . 5) (bar . 6)))}" |
| 120 (lambda (ls) |
| 121 (map (lambda (list-to-translate) |
| 122 (map (lambda (name element) |
| 123 `(,name . ,element)) |
| 124 parameter-list |
| 125 list-to-translate)) |
| 126 ls))) |
| 127 |
| 128 (define (get-spreadsheet-column column spreadsheet) |
| 129 "Gets all the values in @code{column} form @code{spreadsheet} |
| 130 made by @{make-spreadsheet}. |
| 131 For example: |
| 132 @code{guile> (get-spreadsheet-column 'bar ((make-spreadsheet '(foo bar)) '((1
2) (3 4) (5 6))))} |
| 133 @code{(2 4 6)}" |
| 134 (map (lambda (row) (assoc-get column row)) spreadsheet)) |
| 135 |
| 136 (define (make-named-spreadsheet parameter-list) |
| 137 "Makes a named spreadsheet function with columns of parameter-list. |
| 138 This function can then be filled with named rows |
| 139 For example: |
| 140 @code{guile> ((make-named-spreadsheet '(foo bar)) '((x . (1 2)) (y . (3 4)) (
z . (5 6))))} |
| 141 @code{((x (foo . 1) (bar . 2)) (y (foo . 3) (bar . 4)) (z (foo . 5) (bar . 6)
))}" |
| 142 (lambda (ls) |
| 143 (map (lambda (list-to-translate) |
| 144 `(,(list-ref list-to-translate 0) |
| 145 . ,(map (lambda (name element) |
| 146 `(,name . ,element)) |
| 147 parameter-list |
| 148 (list-tail list-to-translate 1)))) |
| 149 ls))) |
| 150 |
| 151 (define (get-named-spreadsheet-column column spreadsheet) |
| 152 "Gets all the values in @code{column} form @code{spreadsheet} |
| 153 made by @{make-named-spreadsheet}. |
| 154 For example: |
| 155 @code{guile> (get-spreadsheet-column 'bar ((make-named-spreadsheet '(foo bar)
) '((x . (1 2)) (y . (3 4)) (z . (5 6)))))} |
| 156 @code{((x . 2) (y . 4) (z . 6))}" |
| 157 (map |
| 158 (lambda (row) (cons (car row) (assoc-get column (cdr row)))) |
| 159 spreadsheet)) |
| 160 |
| 161 ; More this-file specific utility functions |
| 162 ; (ie not really useful anywhere else) |
| 163 |
| 164 (define (bezier-head-for-stencil bezier cut-point) |
| 165 "Prepares a split-bezier to be used in a connected shape stencil." |
| 166 (list-tail (flatten-list (car (split-bezier bezier cut-point))) 2)) |
| 167 |
| 168 (define make-key-alist |
| 169 (make-named-spreadsheet '(name offset graphical textual))) |
| 170 |
| 171 (define (simple-stencil-alist stencil offset) |
| 172 "A stencil alist that contains one and only one stencil. |
| 173 Shorthand used repeatedly in various instruments." |
| 174 `((stencils . (,stencil)) |
| 175 (offset . ,offset) |
| 176 (textual? . #f) |
| 177 (xy-scale-function . (,return-1 . ,return-1)))) |
| 178 |
| 179 (define (make-central-column-hole-addresses keys) |
| 180 "Takes @code{keys} and ascribes them to the central column." |
| 181 (map |
| 182 (lambda (key) `(central-column . ,key)) |
| 183 keys)) |
| 184 |
| 185 (define (make-key-symbols hand) |
| 186 "Takes @code{hand} and ascribes @code{key} to it." |
| 187 (lambda (keys) |
| 188 (map (lambda (key) `(,hand . ,key)) |
| 189 keys))) |
| 190 |
| 191 (define make-left-hand-key-addresses (make-key-symbols 'left-hand)) |
| 192 |
| 193 (define make-right-hand-key-addresses (make-key-symbols 'right-hand)) |
| 194 |
| 195 ;; Translators for keys |
| 196 |
| 197 ; Translates a "normal" key (open, closed, trill) |
| 198 (define (key-fill-translate fill) |
| 199 (cond |
| 200 ((= fill 1) #f) |
| 201 ((= fill 2) #f) |
| 202 ((= fill (expt (assoc-get 'F HOLE-FILL-LIST) 2)) 0.5) |
| 203 ((= fill (assoc-get 'F HOLE-FILL-LIST)) #t))) |
| 204 |
| 205 ; Similar to above, but trans vs opaque doesn't matter |
| 206 (define (text-fill-translate fill) |
| 207 (cond |
| 208 ((< fill 3) 1.0) |
| 209 ((= fill (expt (assoc-get 'F HOLE-FILL-LIST) 2)) 0.5) |
| 210 ((= fill (assoc-get 'F HOLE-FILL-LIST)) 0.0))) |
| 211 |
| 212 ; Emits a list for the central-column-hole maker |
| 213 ; (not-full?, 1-quarter-full?, 1-half-full?, 3-quarters-full?, full?) |
| 214 ; Multiple values, such as (#t #f #f #t #f), mean a trill between |
| 215 ; not-full and 3-quarters-full |
| 216 (define (process-fill-value fill) |
| 217 (let* ((avals (list-tail (assoc-values HOLE-FILL-LIST) 1))) |
| 218 (append `(,(or (< fill 3) (is-square? fill avals))) |
| 219 (map (lambda (x) (= 0 (remainder fill x))) avals)))) |
| 220 |
| 221 ; Color a stencil gray |
| 222 (define (gray-colorize stencil) |
| 223 (apply ly:stencil-in-color (cons stencil (x11-color 'grey)))) |
| 224 |
| 225 ; A connected shape stencil that is surrounded by proc |
| 226 (define (rich-mcs-stencil ls x-stretch y-stretch proc) |
| 227 (lambda (radius thick fill layout props) |
| 228 (let* |
| 229 ((fill-translate (key-fill-translate fill)) |
| 230 (gray? (eqv? fill-translate 0.5))) |
| 231 (ly:stencil-add |
| 232 ((if gray? gray-colorize identity) |
| 233 (proc |
| 234 (make-connected-shape-stencil |
| 235 ls |
| 236 thick |
| 237 (* x-stretch radius) |
| 238 (* y-stretch radius) |
| 239 #f |
| 240 (if gray? #t fill-translate)))) |
| 241 (if (not gray?) |
| 242 empty-stencil |
| 243 ((rich-mcs-stencil ls x-stretch y-stretch proc) |
| 244 radius |
| 245 thick |
| 246 1 |
| 247 layout |
| 248 props)))))) |
| 249 |
| 250 ; A connected shape stencil without a surrounding proc |
| 251 (define (standard-mcs-stencil ls x-stretch y-stretch) |
| 252 (rich-mcs-stencil ls x-stretch y-stretch identity)) |
| 253 |
| 254 ; An ellipse stencil that is surrounded by a proc |
| 255 (define (rich-pe-stencil x-stretch y-stretch start end proc) |
| 256 (lambda (radius thick fill layout props) |
| 257 (let* |
| 258 ((fill-translate (key-fill-translate fill)) |
| 259 (gray? (eqv? fill-translate 0.5))) |
| 260 (ly:stencil-add |
| 261 ((if gray? gray-colorize identity) |
| 262 (proc |
| 263 (make-partial-ellipse-stencil |
| 264 (* x-stretch radius) |
| 265 (* y-stretch radius) |
| 266 start |
| 267 end |
| 268 thick |
| 269 #t |
| 270 (if gray? #t fill-translate)))) |
| 271 (if (not gray?) |
| 272 empty-stencil |
| 273 ((rich-pe-stencil x-stretch y-stretch start end proc) |
| 274 radius |
| 275 thick |
| 276 1 |
| 277 layout |
| 278 props)))))) |
| 279 |
| 280 (define (rich-e-stencil x-stretch y-stretch proc) |
| 281 (lambda (radius thick fill layout props) |
| 282 (let* |
| 283 ((fill-translate (key-fill-translate fill)) |
| 284 (gray? (eqv? fill-translate 0.5))) |
| 285 (ly:stencil-add |
| 286 ((if gray? gray-colorize identity) |
| 287 (proc |
| 288 (make-ellipse-stencil |
| 289 (* x-stretch radius) |
| 290 (* y-stretch radius) |
| 291 thick |
| 292 (if gray? #t fill-translate)))) |
| 293 (if (not gray?) |
| 294 empty-stencil |
| 295 ((rich-e-stencil x-stretch y-stretch proc) |
| 296 radius |
| 297 thick |
| 298 1 |
| 299 layout |
| 300 props)))))) |
| 301 |
| 302 ; An ellipse stencil without a surrounding proc |
| 303 (define (standard-e-stencil x-stretch y-stretch) |
| 304 (rich-e-stencil x-stretch y-stretch identity)) |
| 305 |
| 306 ; Translates all possible representations of symbol. |
| 307 ; If simple? then the only representations are open, closed, and trill. |
| 308 ; Otherwise, there can be various levels of "closure" on the holes |
| 309 ; ring? allows for a ring around the holes as well |
| 310 (define (make-symbol-alist symbol simple? ring?) |
| 311 (filter |
| 312 (lambda (x) |
| 313 (not |
| 314 (equal? |
| 315 x |
| 316 `(,(symbol-concatenate symbol 'T 'F) . |
| 317 ,(expt (assoc-get 'F HOLE-FILL-LIST) 2))))) |
| 318 (append |
| 319 `((,symbol . ,(assoc-get 'F HOLE-FILL-LIST)) |
| 320 (,(symbol-concatenate symbol 'T) . |
| 321 ,(expt (assoc-get 'F HOLE-FILL-LIST) 2))) |
| 322 (if simple? |
| 323 '() |
| 324 (apply append |
| 325 (map |
| 326 (lambda (x) |
| 327 (append |
| 328 `((,(symbol-concatenate symbol (car x) 'T) . |
| 329 ,(expt (cdr x) 2)) |
| 330 (,(symbol-concatenate symbol 'T (car x)) . |
| 331 ,(* (cdr x) (assoc-get 'F HOLE-FILL-LIST))) |
| 332 (,(symbol-concatenate symbol (car x)) . ,(cdr x))) |
| 333 (apply append |
| 334 (map |
| 335 (lambda (y) |
| 336 (map |
| 337 (lambda (a b) |
| 338 `(,(symbol-concatenate symbol |
| 339 (car a) |
| 340 'T |
| 341 (car b)) |
| 342 . ,(* (cdr a) (cdr b)))) |
| 343 `(,x ,y) `(,y ,x))) |
| 344 (cdr (member x HOLE-FILL-LIST)))))) |
| 345 (if ring? HOLE-FILL-LIST (cdr HOLE-FILL-LIST)))))))) |
| 346 |
| 347 ;;; Commands for text layout |
| 348 |
| 349 ; Draws a circle around markup if (= trigger 0.5) |
| 350 (define-markup-command |
| 351 (conditional-circle-markup layout props trigger in-markup) |
| 352 (number? markup?) |
| 353 (interpret-markup layout props |
| 354 (if (eqv? trigger 0.5) |
| 355 (markup #:circle (markup in-markup)) |
| 356 (markup in-markup)))) |
| 357 |
| 358 ; Makes a list of named-keys |
| 359 (define (make-name-keylist input-list key-list font-size) |
| 360 (map (lambda (x y) |
| 361 (if (< x 1) |
| 362 (markup #:conditional-circle-markup |
| 363 x |
| 364 (make-concat-markup |
| 365 (list |
| 366 (markup #:abs-fontsize font-size (car y)) |
| 367 (if (and (< x 1) (cdr y)) |
| 368 (if (eqv? (cdr y) 1) |
| 369 (markup |
| 370 #:abs-fontsize |
| 371 font-size |
| 372 #:raise |
| 373 1 |
| 374 #:fontsize |
| 375 -2 |
| 376 #:sharp) |
| 377 (markup |
| 378 #:abs-fontsize |
| 379 font-size |
| 380 #:raise |
| 381 1 |
| 382 #:fontsize |
| 383 -2 |
| 384 #:flat)) |
| 385 (markup #:null))))) |
| 386 (markup #:null))) |
| 387 input-list key-list)) |
| 388 |
| 389 ; Makes a list of number-keys |
| 390 (define (make-number-keylist input-list key-list font-size) |
| 391 (map |
| 392 (lambda (x y) |
| 393 (if (< x 1) |
| 394 (markup |
| 395 #:conditional-circle-markup |
| 396 x |
| 397 (markup #:abs-fontsize font-size #:number y)) |
| 398 (markup #:null))) |
| 399 input-list |
| 400 key-list)) |
| 401 |
| 402 ; Creates a named-key list with a certain alignment |
| 403 (define (aligned-text-stencil-function dir hv) |
| 404 (lambda (key-name-list radius fill-list layout props) |
| 405 (interpret-markup |
| 406 layout |
| 407 props |
| 408 (make-general-align-markup |
| 409 X |
| 410 dir |
| 411 ((if hv make-concat-markup make-center-column-markup) |
| 412 (make-name-keylist |
| 413 (map text-fill-translate fill-list) |
| 414 key-name-list |
| 415 (* 12 radius))))))) |
| 416 |
| 417 (define number-column-stencil |
| 418 (lambda (key-name-list radius fill-list layout props) |
| 419 (interpret-markup |
| 420 layout |
| 421 props |
| 422 (make-general-align-markup |
| 423 Y |
| 424 CENTER |
| 425 (make-general-align-markup |
| 426 X |
| 427 RIGHT |
| 428 (make-override-markup |
| 429 '(baseline-skip . 0) |
| 430 (make-column-markup |
| 431 (make-number-keylist |
| 432 (map text-fill-translate fill-list) |
| 433 key-name-list |
| 434 (* radius 8))))))))) |
| 435 |
| 436 ; Utility function for the left-hand keys |
| 437 (define lh-woodwind-text-stencil |
| 438 (aligned-text-stencil-function LEFT #t)) |
| 439 |
| 440 ; Utility function for the right-hand keys |
| 441 (define rh-woodwind-text-stencil |
| 442 (aligned-text-stencil-function RIGHT #t)) |
| 443 |
| 444 (define octave-woodwind-text-stencil |
| 445 (aligned-text-stencil-function CENTER #f)) |
| 446 |
| 447 ;;; Draw rules |
| 448 |
| 449 (define (rich-group-draw-rule alist target-part change-part) |
| 450 (if |
| 451 (entry-greater-than-x? |
| 452 (map (lambda (key) (assoc-get key alist)) target-part) 3) |
| 453 (map-selected-alist-keys (lambda (x) (if (= x 0) 1 x)) change-part alist) |
| 454 alist)) |
| 455 |
| 456 (define (bassoon-midline-rule alist target-part) |
| 457 (if |
| 458 (entry-greater-than-x? |
| 459 (map (lambda (key) (assoc-get key alist)) target-part) 0) |
| 460 (map-selected-alist-keys (lambda (x) 1) '((hidden . long-midline)) alist) |
| 461 (map-selected-alist-keys (lambda (x) 1) '((hidden . midline)) alist))) |
| 462 |
| 463 (define (group-draw-rule alist target-part) |
| 464 (rich-group-draw-rule alist target-part target-part)) |
| 465 |
| 466 (define (group-automate-rule alist change-part) |
| 467 (map-selected-alist-keys (lambda (x) (if (= x 0) 1 x)) change-part alist)) |
| 468 |
| 469 (define (apply-group-draw-rule-series alist target-part-list) |
| 470 (if (null? target-part-list) |
| 471 alist |
| 472 (apply-group-draw-rule-series |
| 473 (group-draw-rule alist (car target-part-list)) |
| 474 (cdr target-part-list)))) |
| 475 |
| 476 ;; Extra-offset rules |
| 477 |
| 478 (define (rich-group-extra-offset-rule alist target-part change-part eos) |
| 479 (if |
| 480 (entry-greater-than-x? |
| 481 (map (lambda (key) (assoc-get key alist)) target-part) 0) |
| 482 (map-selected-alist-keys (lambda (x) eos) change-part alist) |
| 483 alist)) |
| 484 |
| 485 (define (group-extra-offset-rule alist target-part eos) |
| 486 (rich-group-extra-offset-rule alist target-part target-part eos)) |
| 487 |
| 488 (define (uniform-extra-offset-rule alist eos) |
| 489 (map-selected-alist-keys |
| 490 (lambda (x) (if (pair? x) x eos)) |
| 491 (assoc-keys alist) |
| 492 alist)) |
| 493 |
| 494 ;;; General drawing commands |
| 495 |
| 496 ; Used all the time for a dividing line |
| 497 (define (midline-stencil radius thick fill layout props) |
| 498 (make-line-stencil (* thick 2) (* -0.80 radius) 0 (* 0.80 radius) 0)) |
| 499 |
| 500 (define (long-midline-stencil radius thick fill layout props) |
| 501 (make-line-stencil (* thick 2) (* -5.75 radius) 0 (* 0.75 radius) 0)) |
| 502 |
| 503 ; Used all the time for a small, between-hole key |
| 504 (define little-elliptical-key-stencil (standard-e-stencil 0.75 0.2)) |
| 505 |
| 506 ; Used for several upper keys in the clarinet and sax |
| 507 (define (upper-key-stencil tailw tailh bodyw bodyh) |
| 508 (let* |
| 509 ((xmove (lambda (x) (+ tailw (+ 0.2 (* bodyw (- x 0.2)))))) |
| 510 (ymove (lambda (x) (+ (- tailh) (+ -0.05 (* bodyh (+ x 0.05))))))) |
| 511 (standard-mcs-stencil |
| 512 `((,(xmove 0.7) |
| 513 ,(ymove -0.2) |
| 514 ,(xmove 1.0) |
| 515 ,(ymove -1.0) |
| 516 ,(xmove 0.5) |
| 517 ,(ymove -1.0)) |
| 518 (,(xmove 0.2) |
| 519 ,(ymove -1.0) |
| 520 ,(xmove 0.2) |
| 521 ,(ymove -0.2) |
| 522 ,(xmove 0.3) |
| 523 ,(ymove -0.1)) |
| 524 (,(+ 0.2 tailw) |
| 525 ,(- -0.05 tailh) |
| 526 ,(+ 0.1 (/ tailw 2)) |
| 527 ,(- -0.025 (/ tailh 2)) |
| 528 0.0 |
| 529 0.0)) |
| 530 1.0 |
| 531 1.0))) |
| 532 |
| 533 ; Utility function for the column-hole maker. |
| 534 ; Returns the left and right degrees for the drawing of a given |
| 535 ; fill level (1-quarter, 1-half, etc...) |
| 536 (define (degree-first-true fill-list left? reverse?) |
| 537 (define (dfl-crawler fill-list os-list left?) |
| 538 (if (car fill-list) |
| 539 ((if left? car cdr) (car os-list)) |
| 540 (dfl-crawler (cdr fill-list) (cdr os-list) left?))) |
| 541 (dfl-crawler |
| 542 ((if reverse? reverse identity) fill-list) |
| 543 ((if reverse? reverse identity) |
| 544 '((0 . 0) (215 . 325) (180 . 0) (145 . 35) (90 . 90))) |
| 545 left?)) |
| 546 |
| 547 ; Gets the position of the first (or last if reverse?) element of a list. |
| 548 (define (position-true-endpoint in-list reverse?) |
| 549 (define (pte-crawler in-list n) |
| 550 (if (car in-list) |
| 551 n |
| 552 (pte-crawler (cdr in-list) (+ n 1)))) |
| 553 ((if reverse? - +) |
| 554 (if reverse? (length in-list) 0) |
| 555 (pte-crawler ((if reverse? reverse identity) in-list) 0))) |
| 556 |
| 557 ; Huge, kind-of-ugly maker of a circle in a column. |
| 558 ; I think this is the clearest way to write it, though... |
| 559 |
| 560 (define (column-circle-stencil radius thick fill layout props) |
| 561 (let* ((fill-list (process-fill-value fill))) |
| 562 (cond |
| 563 ((and |
| 564 (list-ref fill-list 0) |
| 565 (not (true-entry? (list-tail fill-list 1)))) ; is it empty? |
| 566 ((standard-e-stencil 1.0 1.0) radius thick fill layout props)) |
| 567 ((and |
| 568 (list-ref fill-list 4) |
| 569 (not (true-entry? (list-head fill-list 4)))) ; is it full? |
| 570 ((standard-e-stencil 1.0 1.0) radius thick fill layout props)) |
| 571 ((and |
| 572 (list-ref fill-list 0) |
| 573 (list-ref fill-list 4)) ; is it a trill between empty and full? |
| 574 ((standard-e-stencil 1.0 1.0) radius thick fill layout props)) |
| 575 (else ;If none of these, it is partially full. |
| 576 (ly:stencil-add |
| 577 ((rich-pe-stencil 1.0 1.0 0 360 identity) |
| 578 radius |
| 579 thick |
| 580 (if (list-ref fill-list 4) |
| 581 (expt (assoc-get 'F HOLE-FILL-LIST) 2) |
| 582 1) |
| 583 layout |
| 584 props) |
| 585 ((rich-pe-stencil |
| 586 1.0 |
| 587 1.0 |
| 588 (degree-first-true fill-list #t #t) |
| 589 (degree-first-true fill-list #f #t) |
| 590 identity) |
| 591 radius |
| 592 thick |
| 593 (if |
| 594 (true-entry? |
| 595 (list-head fill-list (position-true-endpoint fill-list #t))) |
| 596 (expt (assoc-get 'F HOLE-FILL-LIST) 2) |
| 597 (assoc-get 'F HOLE-FILL-LIST)) |
| 598 layout |
| 599 props) |
| 600 (if |
| 601 (= 2 (n-true-entries (list-tail fill-list 1))) ; trill? |
| 602 ((rich-pe-stencil |
| 603 1.0 |
| 604 1.0 |
| 605 (degree-first-true fill-list #t #f) |
| 606 (degree-first-true fill-list #f #f) |
| 607 identity) |
| 608 radius |
| 609 thick |
| 610 (assoc-get 'F HOLE-FILL-LIST) |
| 611 layout |
| 612 props) |
| 613 empty-stencil)))))) |
| 614 |
| 615 (define (variable-column-circle-stencil scaler) |
| 616 (lambda |
| 617 (radius thick fill layout props) |
| 618 (column-circle-stencil (* radius scaler) thick fill layout props))) |
| 619 |
| 620 ; A stencil for ring-column circles that combines two of the above |
| 621 (define (ring-column-circle-stencil radius thick fill layout props) |
| 622 (if (= 0 (remainder fill (assoc-get 'R HOLE-FILL-LIST))) |
| 623 (ly:stencil-add |
| 624 ((if |
| 625 (= fill (expt (assoc-get 'R HOLE-FILL-LIST) 2)) |
| 626 gray-colorize |
| 627 identity) |
| 628 ((standard-e-stencil |
| 629 (* (+ (- 1.0 (* 2 thick)) (/ thick 2))) |
| 630 (* (+ (- 1.0 (* 2 thick)) (/ thick 2)))) |
| 631 radius |
| 632 (* (* 4 radius) thick) |
| 633 1 |
| 634 layout |
| 635 props)) |
| 636 ((standard-e-stencil 1.0 1.0) radius thick 1 layout props) |
| 637 (column-circle-stencil |
| 638 (+ (* (- 1.0 (* 4 thick)) radius) (/ thick 2)) |
| 639 thick |
| 640 (* |
| 641 (if (= 0 (remainder fill (assoc-get 'F HOLE-FILL-LIST))) |
| 642 (assoc-get 'F HOLE-FILL-LIST) |
| 643 1) |
| 644 (if (= fill (expt (assoc-get 'R HOLE-FILL-LIST) 2)) |
| 645 (/ fill (expt (assoc-get 'R HOLE-FILL-LIST) 2)) |
| 646 (/ fill (assoc-get 'R HOLE-FILL-LIST)))) |
| 647 layout |
| 648 props)) |
| 649 (column-circle-stencil radius thick fill layout props))) |
| 650 |
| 651 ;;; Flute family stencils |
| 652 |
| 653 (define flute-lh-b-key-stencil |
| 654 (standard-mcs-stencil |
| 655 '((0 1.3) |
| 656 (0 1.625 -0.125 1.75 -0.25 1.75) |
| 657 (-0.55 1.75 -0.55 0.95 -0.25 0.7) |
| 658 (0 0.4 0 0.125 0 0)) |
| 659 2 |
| 660 1.55)) |
| 661 |
| 662 (define flute-lh-bes-key-stencil |
| 663 (standard-mcs-stencil |
| 664 '((0 1.3) |
| 665 (0 1.625 -0.125 1.75 -0.25 1.75) |
| 666 (-0.55 1.75 -0.55 0.95 -0.25 0.7) |
| 667 (0 0.4 0 0.125 0 0)) |
| 668 2.0 |
| 669 1.3)) |
| 670 |
| 671 (define (flute-lh-gis-rh-bes-key-stencil deg) |
| 672 (rich-mcs-stencil |
| 673 '((0.1 0.1 0.2 0.4 0.3 0.6) |
| 674 (0.3 1.0 0.8 1.0 0.8 0.7) |
| 675 (0.8 0.3 0.5 0.3 0 0)) |
| 676 1.0 |
| 677 1.0 |
| 678 (lambda (stencil) (ly:stencil-rotate stencil deg 0 0)))) |
| 679 |
| 680 (define flute-lh-gis-key-stencil (flute-lh-gis-rh-bes-key-stencil 0)) |
| 681 |
| 682 (define flute-rh-bes-key-stencil (flute-lh-gis-rh-bes-key-stencil 200)) |
| 683 |
| 684 (define flute-rh-d-key-stencil little-elliptical-key-stencil) |
| 685 |
| 686 (define flute-rh-dis-key-stencil little-elliptical-key-stencil) |
| 687 |
| 688 (define flute-rh-ees-key-stencil |
| 689 (standard-mcs-stencil |
| 690 '((0.8 0) (1.1 0 1.1 0.75 0.7 0.75) (0.5 0.75) (0.15 0.75 0.1 0.2 0 0)) |
| 691 -2.38 |
| 692 1.4)) |
| 693 |
| 694 (define (piccolo-rh-x-key-stencil radius thick fill layout props) |
| 695 (interpret-markup |
| 696 layout |
| 697 props |
| 698 (make-general-align-markup |
| 699 Y |
| 700 DOWN |
| 701 (make-concat-markup |
| 702 (make-name-keylist |
| 703 `(,(text-fill-translate fill)) |
| 704 '(("X" . #f)) |
| 705 (* 9 radius)))))) |
| 706 |
| 707 (define flute-lower-row-stretch 1.4) |
| 708 |
| 709 (define flute-rh-cis-key-stencil |
| 710 (standard-mcs-stencil |
| 711 '((0 0.75) (-0.8 0.75 -0.8 0 0 0)) |
| 712 flute-lower-row-stretch |
| 713 flute-lower-row-stretch)) |
| 714 |
| 715 (define flute-rh-c-key-stencil |
| 716 (standard-mcs-stencil |
| 717 '((0 0.75) (0.4 0.75) (0.4 0) (0 0)) |
| 718 flute-lower-row-stretch |
| 719 flute-lower-row-stretch)) |
| 720 |
| 721 (define flute-rh-b-key-stencil |
| 722 (standard-mcs-stencil |
| 723 '((0 0.75) (0.25 0.75) (0.25 0) (0 0)) |
| 724 flute-lower-row-stretch |
| 725 flute-lower-row-stretch)) |
| 726 |
| 727 (define flute-rh-gz-key-stencil |
| 728 (rich-mcs-stencil |
| 729 '((0.1 0.1 0.4 0.2 0.6 0.3) |
| 730 (1.0 0.3 1.0 0.8 0.7 0.8) |
| 731 (0.3 0.8 0.3 0.5 0 0)) |
| 732 flute-lower-row-stretch |
| 733 flute-lower-row-stretch |
| 734 (lambda (stencil) (ly:stencil-rotate stencil 160 0 0)))) |
| 735 |
| 736 (define flute-change-points |
| 737 ((make-named-spreadsheet '(piccolo flute flute-b-extension)) |
| 738 `((bottom-group-key-names |
| 739 . (((x |
| 740 . ((offset . (-0.45 . -1.05)) |
| 741 (stencil . ,piccolo-rh-x-key-stencil) |
| 742 (text? . ("X" . #f)) |
| 743 (complexity . trill)))) |
| 744 ((cis |
| 745 . ((offset . (0.0 . 0.0)) |
| 746 (stencil . ,flute-rh-cis-key-stencil) |
| 747 (text? . ("C" . 1)) |
| 748 (complexity . trill))) |
| 749 (c |
| 750 . ((offset . (0.3 . 0.0)) |
| 751 (stencil . ,flute-rh-c-key-stencil) |
| 752 (text? . ("C" . #f)) |
| 753 (complexity . trill))) |
| 754 (gz |
| 755 . ((offset . (0.0 . -1.2)) |
| 756 (stencil . ,flute-rh-gz-key-stencil) |
| 757 (text? . ("gz" . #f)) |
| 758 (complexity . trill)))) |
| 759 ((cis |
| 760 . ((offset . (0.0 . 0.0)) |
| 761 (stencil . ,flute-rh-cis-key-stencil) |
| 762 (text? . ("C" . 1)) |
| 763 (complexity . trill))) |
| 764 (c |
| 765 . ((offset . (0.3 . 0.0)) |
| 766 (stencil . ,flute-rh-c-key-stencil) |
| 767 (text? . ("C" . #f)) |
| 768 (complexity . trill))) |
| 769 (b |
| 770 . ((offset . (1.0 . 0.0)) |
| 771 (stencil . ,flute-rh-b-key-stencil) |
| 772 (text? . ("B" . #f)) |
| 773 (complexity . trill))) |
| 774 (gz |
| 775 . ((offset . (0.0 . -1.2)) |
| 776 (stencil . ,flute-rh-gz-key-stencil) |
| 777 (text? . ("gz" . #f)) |
| 778 (complexity . trill)))))) |
| 779 (bottom-group-graphical-stencil |
| 780 . (((right-hand . ees) (right-hand . x)) |
| 781 ,(make-right-hand-key-addresses '(ees cis c gz)) |
| 782 ,(make-right-hand-key-addresses '(ees cis c b gz)))) |
| 783 (bottom-group-graphical-draw-instruction |
| 784 . (((right-hand . ees)) |
| 785 ,(make-right-hand-key-addresses '(ees cis c)) |
| 786 ,(make-right-hand-key-addresses '(ees cis c b)))) |
| 787 (bottom-group-special-key-instruction |
| 788 . ((,rich-group-draw-rule ((right-hand . x)) ((right-hand . ees))) |
| 789 (,rich-group-draw-rule ((right-hand . gz)) |
| 790 ,(make-right-hand-key-addresses |
| 791 '(ees cis c))) |
| 792 (,rich-group-draw-rule ((right-hand . gz)) |
| 793 ,(make-right-hand-key-addresses |
| 794 '(ees cis c b))))) |
| 795 (bottom-group-text-stencil |
| 796 . (,(make-right-hand-key-addresses '(bes d dis ees x)) |
| 797 ,(make-right-hand-key-addresses '(bes d dis ees cis c gz)) |
| 798 ,(make-right-hand-key-addresses '(bes d dis ees cis c b gz))))))) |
| 799 |
| 800 (define (generate-flute-family-entry flute-name) |
| 801 (let* |
| 802 ((change-points |
| 803 (get-named-spreadsheet-column |
| 804 flute-name |
| 805 flute-change-points))) |
| 806 `(,flute-name |
| 807 . ((keys |
| 808 . ((hidden |
| 809 . ((midline |
| 810 . ((offset . (0.0 . 0.0)) |
| 811 (stencil . ,midline-stencil) |
| 812 (text? . #f) |
| 813 (complexity . basic))))) |
| 814 (central-column |
| 815 . ((one |
| 816 . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 817 (stencil . ,ring-column-circle-stencil) |
| 818 (text? . #f) |
| 819 (complexity . ring))) |
| 820 (two |
| 821 . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 822 (stencil . ,ring-column-circle-stencil) |
| 823 (text? . #f) |
| 824 (complexity . ring))) |
| 825 (three |
| 826 . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 827 (stencil . ,ring-column-circle-stencil) |
| 828 (text? . #f) |
| 829 (complexity . ring))) |
| 830 (four |
| 831 . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 832 (stencil . ,ring-column-circle-stencil) |
| 833 (text? . #f) |
| 834 (complexity . ring))) |
| 835 (five |
| 836 . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 837 (stencil . ,ring-column-circle-stencil) |
| 838 (text? . #f) |
| 839 (complexity . ring))) |
| 840 (six |
| 841 . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 842 (stencil . ,ring-column-circle-stencil) |
| 843 (text? . #f) |
| 844 (complexity . ring))))) |
| 845 (left-hand |
| 846 . ((bes |
| 847 . ((offset . (0.5 . 1.8)) |
| 848 (stencil . ,flute-lh-bes-key-stencil) |
| 849 (text? . ("B" . 0)) |
| 850 (complexity . trill))) |
| 851 (b |
| 852 . ((offset . (0.0 . 0.0)) |
| 853 (stencil . ,flute-lh-b-key-stencil) |
| 854 (text? . ("B" . #f)) |
| 855 (complexity . trill))) |
| 856 (gis |
| 857 . ((offset . (0.0 . 0.0)) |
| 858 (stencil . ,flute-lh-gis-key-stencil) |
| 859 (text? . ("G" . 1)) |
| 860 (complexity . trill))))) |
| 861 (right-hand |
| 862 . ,(append `((bes |
| 863 . ((offset . (0.0 . 0.0)) |
| 864 (stencil . ,flute-rh-bes-key-stencil) |
| 865 (text? . ("B" . 0)) |
| 866 (complexity . trill))) |
| 867 (d |
| 868 . ((offset . (0.0 . 0.0)) |
| 869 (stencil . ,flute-rh-d-key-stencil) |
| 870 (text? . ("D" . #f)) |
| 871 (complexity . trill))) |
| 872 (dis |
| 873 . ((offset . (0.0 . 0.0)) |
| 874 (stencil . ,flute-rh-dis-key-stencil) |
| 875 (text? . ("D" . 1)) |
| 876 (complexity . trill))) |
| 877 (ees |
| 878 . ((offset . (1.5 . 1.3)) |
| 879 (stencil . ,flute-rh-ees-key-stencil) |
| 880 (text? . ("E" . 0)) |
| 881 (complexity . trill)))) |
| 882 (assoc-get 'bottom-group-key-names change-points))))) |
| 883 (graphical-commands |
| 884 . ((stencil-alist |
| 885 . ((stencils |
| 886 . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) |
| 887 ((stencils |
| 888 . ,(make-central-column-hole-addresses |
| 889 CENTRAL-COLUMN-HOLE-LIST)) |
| 890 (xy-scale-function . (,identity . ,identity)) |
| 891 (textual? . #f) |
| 892 (offset . (0.0 . 0.0))) |
| 893 ((stencils . ((left-hand . bes) (left-hand . b))) |
| 894 (xy-scale-function . (,return-1 . ,return-1)) |
| 895 (textual? . #f) |
| 896 (offset . (-1.5 . 6.5))) |
| 897 ,(simple-stencil-alist '(left-hand . gis) '(1.0 . 4.0)) |
| 898 ,(simple-stencil-alist '(right-hand . bes) '(-1.75 . 3.05)) |
| 899 ,(simple-stencil-alist '(right-hand . d) '(-1.0 . 2.5)) |
| 900 ,(simple-stencil-alist '(right-hand . dis) '(-1.0 . 1.5)) |
| 901 ((stencils |
| 902 . ,(assoc-get 'bottom-group-graphical-stencil |
| 903 change-points)) |
| 904 (xy-scale-function . (,return-1 . ,return-1)) |
| 905 (textual? . #f) |
| 906 (offset . (0.0 . -0.6))))) |
| 907 (xy-scale-function . (,identity . ,identity)) |
| 908 (textual? . #f) |
| 909 (offset . (0.0 . 0.0)))) |
| 910 (draw-instructions |
| 911 . ((,apply-group-draw-rule-series |
| 912 (((left-hand . bes) (left-hand . b)) |
| 913 ,(assoc-get 'bottom-group-graphical-draw-instruction |
| 914 change-points))) |
| 915 ,(assoc-get 'bottom-group-special-key-instruction |
| 916 change-points) |
| 917 (,group-automate-rule |
| 918 ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) |
| 919 (,group-automate-rule ((hidden . midline))))) |
| 920 (extra-offset-instructions |
| 921 . ((,uniform-extra-offset-rule (0.0 . 0.0)))))) |
| 922 (text-commands |
| 923 . ((stencil-alist |
| 924 . ((stencils |
| 925 . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) |
| 926 ((stencils |
| 927 . ,(make-central-column-hole-addresses |
| 928 CENTRAL-COLUMN-HOLE-LIST)) |
| 929 (xy-scale-function . (,identity . ,identity)) |
| 930 (textual? . #f) |
| 931 (offset . (0.0 . 0.0))) |
| 932 ((stencils . ,(make-left-hand-key-addresses '(bes b gis))) |
| 933 (textual? . ,lh-woodwind-text-stencil) |
| 934 (offset . (1.5 . 3.75))) |
| 935 ((stencils . ,(assoc-get 'bottom-group-text-stencil |
| 936 change-points)) |
| 937 (textual? . ,rh-woodwind-text-stencil) |
| 938 (offset . (-1.25 . 0.0))))) |
| 939 (xy-scale-function . (,identity . ,identity)) |
| 940 (textual? . #f) |
| 941 (offset . (0.0 . 0.0)))) |
| 942 (draw-instructions |
| 943 . ((,apply-group-draw-rule-series |
| 944 (,(make-left-hand-key-addresses '(bes b gis)) |
| 945 ,(assoc-get 'bottom-group-text-stencil change-points))) |
| 946 (,group-automate-rule |
| 947 ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) |
| 948 (,group-automate-rule ((hidden . midline))))) |
| 949 (extra-offset-instructions |
| 950 . ((,uniform-extra-offset-rule (0.0 . 0.0)))))))))) |
| 951 |
| 952 ;;; Shared oboe/clarinet stencils |
| 953 |
| 954 (define (oboe-lh-gis-lh-low-b-key-stencil gis?) |
| 955 (let* |
| 956 ((x 1.2) |
| 957 (y 0.4) |
| 958 (scaling-factor 1.7) |
| 959 (up-part |
| 960 (car |
| 961 (split-bezier |
| 962 `((0.0 . 0.0) (0.0 . ,y) (,x . ,y) (,x . 0.0)) |
| 963 0.8))) |
| 964 (down-part |
| 965 (cdr |
| 966 (split-bezier |
| 967 `((,x . 0.0) (,x . ,(- y)) (0.0 . ,(- y)) (0.0 . 0.0)) |
| 968 0.2)))) |
| 969 (if gis? |
| 970 (standard-mcs-stencil |
| 971 (append |
| 972 (append `((0.25 ,(/ y -2) 0.75 ,(/ y -2) 1.0 0.0)) |
| 973 (map |
| 974 (lambda |
| 975 (l) |
| 976 (flatten-list |
| 977 (map |
| 978 (lambda |
| 979 (x) |
| 980 (coord-translate |
| 981 (coord-rotate x (atan (/ y (* 2 0.25)))) '(1.0 . 0))) |
| 982 l))) |
| 983 `(((0 . ,y) (,x . ,y) (,x . 0)) |
| 984 ((,x . ,(- y)) (0 . ,(- y)) (0 . 0))))) |
| 985 `((0.75 ,(/ y -2) 0.25 ,(/ y -2) 0.0 0.0))) |
| 986 scaling-factor |
| 987 scaling-factor) |
| 988 (standard-mcs-stencil |
| 989 (map |
| 990 (lambda |
| 991 (l) |
| 992 (flatten-list |
| 993 (map |
| 994 (lambda |
| 995 (x) |
| 996 (coord-rotate x (atan (/ y (* 2 0.25))))) |
| 997 l))) |
| 998 `(,(list-tail up-part 1) |
| 999 ,(list-head down-part 1) |
| 1000 ,(list-tail down-part 1))) |
| 1001 (- scaling-factor) |
| 1002 (- scaling-factor))))) |
| 1003 |
| 1004 (define oboe-lh-gis-key-stencil (oboe-lh-gis-lh-low-b-key-stencil #t)) |
| 1005 |
| 1006 (define oboe-lh-low-b-key-stencil (oboe-lh-gis-lh-low-b-key-stencil #f)) |
| 1007 |
| 1008 (define (oboe-lh-ees-lh-bes-key-stencil ees?) |
| 1009 (standard-mcs-stencil |
| 1010 `((0 1.5) |
| 1011 (0 1.625 -0.125 1.75 -0.25 1.75) |
| 1012 (-0.5 1.75 -0.5 0.816 -0.25 0.5) |
| 1013 (0 0.25 0 0.125 0 0) |
| 1014 (0 ,(if ees? -0.6 -0.3))) |
| 1015 (* (if ees? -1.0 1.0) -1.8) |
| 1016 1.8)) |
| 1017 |
| 1018 (define oboe-lh-ees-key-stencil (oboe-lh-ees-lh-bes-key-stencil #t)) |
| 1019 |
| 1020 (define oboe-lh-bes-key-stencil (oboe-lh-ees-lh-bes-key-stencil #f)) |
| 1021 |
| 1022 ;;; Oboe family stencils |
| 1023 |
| 1024 (define (oboe-lh-octave-key-stencil long?) |
| 1025 (let* ((h (if long? 1.4 1.2))) |
| 1026 (standard-mcs-stencil |
| 1027 `((-0.4 0 -0.4 1.0 -0.1 1.0) |
| 1028 (-0.1 ,h) |
| 1029 (0.1 ,h) |
| 1030 (0.1 1.0) |
| 1031 (0.4 1.0 0.4 0 0 0)) |
| 1032 2.0 |
| 1033 2.0))) |
| 1034 |
| 1035 (define oboe-lh-I-key-stencil (oboe-lh-octave-key-stencil #f)) |
| 1036 |
| 1037 (define oboe-lh-II-key-stencil (oboe-lh-octave-key-stencil #f)) |
| 1038 |
| 1039 (define oboe-lh-III-key-stencil (oboe-lh-octave-key-stencil #t)) |
| 1040 |
| 1041 (define oboe-lh-b-key-stencil (standard-e-stencil 0.6 0.8)) |
| 1042 |
| 1043 (define oboe-lh-d-key-stencil little-elliptical-key-stencil) |
| 1044 |
| 1045 (define oboe-lh-cis-key-stencil little-elliptical-key-stencil) |
| 1046 |
| 1047 (define oboe-lh-f-key-stencil (standard-e-stencil 0.5 1.0)) |
| 1048 |
| 1049 (define oboe-rh-a-key-stencil (standard-e-stencil 1.0 0.45)) |
| 1050 |
| 1051 (define oboe-rh-gis-key-stencil (standard-e-stencil 0.45 1.2)) |
| 1052 |
| 1053 (define oboe-rh-d-key-stencil little-elliptical-key-stencil) |
| 1054 |
| 1055 (define oboe-rh-f-key-stencil little-elliptical-key-stencil) |
| 1056 |
| 1057 (define (oboe-rh-c-rh-ees-key-stencil c?) |
| 1058 (rich-mcs-stencil |
| 1059 '((1.0 0.0 1.0 0.70 1.5 0.70) |
| 1060 (2.25 0.70 2.25 -0.4 1.5 -0.4) |
| 1061 (1.0 -0.4 1.0 0 0 0) |
| 1062 (-0.15 0)) |
| 1063 2.0 |
| 1064 1.4 |
| 1065 (lambda (stencil) (ly:stencil-rotate stencil (if c? 170 180) 0 0)))) |
| 1066 |
| 1067 (define oboe-rh-banana-key-stencil oboe-rh-gis-key-stencil) |
| 1068 |
| 1069 (define oboe-rh-c-key-stencil (oboe-rh-c-rh-ees-key-stencil #t)) |
| 1070 |
| 1071 (define oboe-rh-cis-key-stencil |
| 1072 (rich-mcs-stencil |
| 1073 '((0.6 0.0 0.6 0.50 1.25 0.50) |
| 1074 (2.25 0.50 2.25 -0.4 1.25 -0.4) |
| 1075 (0.6 -0.4 0.6 0 0 0)) |
| 1076 -0.9 |
| 1077 1.0 |
| 1078 (lambda (stencil) (ly:stencil-rotate stencil 0 0 0)))) |
| 1079 |
| 1080 (define oboe-rh-ees-key-stencil (oboe-rh-c-rh-ees-key-stencil #f)) |
| 1081 |
| 1082 (define oboe-change-points |
| 1083 ((make-named-spreadsheet '(oboe)) '())) |
| 1084 |
| 1085 (define (generate-oboe-family-entry oboe-name) |
| 1086 (let* |
| 1087 ((change-points |
| 1088 (get-named-spreadsheet-column oboe-name oboe-change-points))) |
| 1089 `(,oboe-name |
| 1090 . ((keys |
| 1091 . ((hidden |
| 1092 . ((midline |
| 1093 . ((offset . (0.0 . 0.0)) |
| 1094 (stencil . ,midline-stencil) |
| 1095 (text? . #f) |
| 1096 (complexity . basic))))) |
| 1097 (central-column |
| 1098 . ((one |
| 1099 . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1100 (stencil . ,ring-column-circle-stencil) |
| 1101 (text? . #f) |
| 1102 (complexity . ring))) |
| 1103 (two |
| 1104 . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1105 (stencil . ,ring-column-circle-stencil) |
| 1106 (text? . #f) |
| 1107 (complexity . ring))) |
| 1108 (three |
| 1109 . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1110 (stencil . ,ring-column-circle-stencil) |
| 1111 (text? . #f) |
| 1112 (complexity . ring))) |
| 1113 (four |
| 1114 . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1115 (stencil . ,ring-column-circle-stencil) |
| 1116 (text? . #f) |
| 1117 (complexity . ring))) |
| 1118 (five |
| 1119 . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1120 (stencil . ,ring-column-circle-stencil) |
| 1121 (text? . #f) |
| 1122 (complexity . ring))) |
| 1123 (six |
| 1124 . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1125 (stencil . ,ring-column-circle-stencil) |
| 1126 (text? . #f) |
| 1127 (complexity . ring))) |
| 1128 (h |
| 1129 . ((offset . (0.0 . 6.25)) |
| 1130 (stencil . ,(variable-column-circle-stencil 0.4)) |
| 1131 (text? . #f) |
| 1132 (complexity . trill))))) |
| 1133 (left-hand |
| 1134 . ((I |
| 1135 . ((offset . (0.0 . 0.0)) |
| 1136 (stencil . ,oboe-lh-I-key-stencil) |
| 1137 (text? . ("I" . #f)) |
| 1138 (complexity . trill))) |
| 1139 (III |
| 1140 . ((offset . (0.0 . 2.6)) |
| 1141 (stencil . ,oboe-lh-III-key-stencil) |
| 1142 (text? . ("III" . #f)) |
| 1143 (complexity . trill))) |
| 1144 (II |
| 1145 . ((offset . (0.0 . 0.0)) |
| 1146 (stencil . ,oboe-lh-II-key-stencil) |
| 1147 (text? . ("II" . #f)) |
| 1148 (complexity . trill))) |
| 1149 (b |
| 1150 . ((offset . (0.0 . 0.0)) |
| 1151 (stencil . ,oboe-lh-b-key-stencil) |
| 1152 (text? . ("B" . #f)) |
| 1153 (complexity . trill))) |
| 1154 (d |
| 1155 . ((offset . (0.0 . 0.0)) |
| 1156 (stencil . ,oboe-lh-d-key-stencil) |
| 1157 (text? . ("D" . #f)) |
| 1158 (complexity . trill))) |
| 1159 (cis |
| 1160 . ((offset . (0.0 . 0.0)) |
| 1161 (stencil . ,oboe-lh-cis-key-stencil) |
| 1162 (text? . ("C" . 1)) |
| 1163 (complexity . trill))) |
| 1164 (gis |
| 1165 . ((offset . (-0.85 . 0.2)) |
| 1166 (stencil . ,oboe-lh-gis-key-stencil) |
| 1167 (text? . ("G" . 1)) |
| 1168 (complexity . trill))) |
| 1169 (ees |
| 1170 . ((offset . (2.05 . -3.65)) |
| 1171 (stencil . ,oboe-lh-ees-key-stencil) |
| 1172 (text? . ("E" . 0)) |
| 1173 (complexity . trill))) |
| 1174 (low-b |
| 1175 . ((offset . (3.6 . 0.5)) |
| 1176 (stencil . ,oboe-lh-low-b-key-stencil) |
| 1177 (text? . ("b" . #f)) |
| 1178 (complexity . trill))) |
| 1179 (bes |
| 1180 . ((offset . (2.25 . -4.15)) |
| 1181 (stencil . ,oboe-lh-bes-key-stencil) |
| 1182 (text? . ("B" . 0)) |
| 1183 (complexity . trill))) |
| 1184 (f |
| 1185 . ((offset . (2.15 . -3.85)) |
| 1186 (stencil . ,oboe-lh-f-key-stencil) |
| 1187 (text? . ("F" . #f)) |
| 1188 (complexity . trill))))) |
| 1189 (right-hand |
| 1190 . ((a |
| 1191 . ((offset . (1.5 . 1.2)) |
| 1192 (stencil . ,oboe-rh-a-key-stencil) |
| 1193 (text? . ("A" . #f)) |
| 1194 (complexity . trill))) |
| 1195 (gis |
| 1196 . ((offset . (0.0 . 0.0)) |
| 1197 (stencil . ,oboe-rh-gis-key-stencil) |
| 1198 (text? . ("G" . 1)) |
| 1199 (complexity . trill))) |
| 1200 (d |
| 1201 . ((offset . (0.0 . 0.0)) |
| 1202 (stencil . ,oboe-rh-d-key-stencil) |
| 1203 (text? . ("D" . #f)) |
| 1204 (complexity . trill))) |
| 1205 (f |
| 1206 . ((offset . (0.0 . 0.0)) |
| 1207 (stencil . ,oboe-rh-f-key-stencil) |
| 1208 (text? . ("F" . #f)) |
| 1209 (complexity . trill))) |
| 1210 (banana |
| 1211 . ((offset . (0.0 . 0.0)) |
| 1212 (stencil . ,oboe-rh-banana-key-stencil) |
| 1213 (text? . ("ban" . #f)) |
| 1214 (complexity . trill))) |
| 1215 (c |
| 1216 . ((offset . (0.0 . 0.0)) |
| 1217 (stencil . ,oboe-rh-c-key-stencil) |
| 1218 (text? . ("C" . #f)) |
| 1219 (complexity . trill))) |
| 1220 (cis |
| 1221 . ((offset . (3.8 . -0.6)) |
| 1222 (stencil . ,oboe-rh-cis-key-stencil) |
| 1223 (text? . ("C" . 1)) |
| 1224 (complexity . trill))) |
| 1225 (ees |
| 1226 . ((offset . (0.0 . -1.8)) |
| 1227 (stencil . ,oboe-rh-ees-key-stencil) |
| 1228 (text? . ("E" . 0)) |
| 1229 (complexity . trill))))))) |
| 1230 (graphical-commands |
| 1231 . ((stencil-alist |
| 1232 . ((stencils |
| 1233 . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) |
| 1234 ((stencils |
| 1235 . ,(make-central-column-hole-addresses |
| 1236 CENTRAL-COLUMN-HOLE-H-LIST)) |
| 1237 (xy-scale-function . (,identity . ,identity)) |
| 1238 (textual? . #f) |
| 1239 (offset . (0.0 . 0.0))) |
| 1240 ((stencils . ((left-hand . I) (left-hand . III))) |
| 1241 (xy-scale-function . (,return-1 . ,return-1)) |
| 1242 (textual? . #f) |
| 1243 (offset . (-2.5 . 6.5))) |
| 1244 ,(simple-stencil-alist '(left-hand . II) '(2.5 . 6.0)) |
| 1245 ,(simple-stencil-alist '(left-hand . b) '(-1.35 . 6.0)) |
| 1246 ,(simple-stencil-alist '(left-hand . d) '(1.0 . 6.0)) |
| 1247 ,(simple-stencil-alist '(left-hand . cis) '(1.0 . 5.0)) |
| 1248 ((stencils |
| 1249 . ,(make-left-hand-key-addresses '(gis bes low-b ees f))) |
| 1250 (xy-scale-function . (,return-1 . ,return-1)) |
| 1251 (textual? . #f) |
| 1252 (offset . (0.0 . 3.9))) |
| 1253 ((stencils . |
| 1254 ,(make-right-hand-key-addresses '(a gis))) |
| 1255 (xy-scale-function . (,return-1 . ,return-1)) |
| 1256 (textual? . #f) |
| 1257 (offset . (-3.5 . 3.5))) |
| 1258 ,(simple-stencil-alist '(right-hand . d) '(1.0 . 2.5)) |
| 1259 ,(simple-stencil-alist '(right-hand . f) '(-1.0 . 1.5)) |
| 1260 ,(simple-stencil-alist '(right-hand . banana) '(1.7 . 1.0)) |
| 1261 ((stencils . ,(make-right-hand-key-addresses '(c cis ees))) |
| 1262 (xy-scale-function . (,return-1 . ,return-1)) |
| 1263 (textual? . #f) |
| 1264 (offset . (-3.4 . 0.3))))) |
| 1265 (xy-scale-function . (,identity . ,identity)) |
| 1266 (textual? . #f) |
| 1267 (offset . (0.0 . 0.0)))) |
| 1268 (draw-instructions |
| 1269 . ((,apply-group-draw-rule-series |
| 1270 (((right-hand . a) (right-hand . gis)) |
| 1271 ,(make-left-hand-key-addresses '(gis bes low-b ees)) |
| 1272 ,(make-right-hand-key-addresses '(cis c ees)))) |
| 1273 (,rich-group-draw-rule |
| 1274 ((left-hand . III)) |
| 1275 ((left-hand . I))) |
| 1276 (,rich-group-draw-rule |
| 1277 ((left-hand . f)) |
| 1278 ,(make-left-hand-key-addresses '(gis bes low-b ees))) |
| 1279 (,group-automate-rule |
| 1280 ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) |
| 1281 (,group-automate-rule ((hidden . midline))))) |
| 1282 (extra-offset-instructions |
| 1283 . ((,rich-group-extra-offset-rule |
| 1284 ((central-column . h)) ((central-column . one)) (0.0 . 0.8)) |
| 1285 (,uniform-extra-offset-rule (0.0 . 0.0)))))) |
| 1286 (text-commands |
| 1287 . ((stencil-alist |
| 1288 . ((stencils . |
| 1289 (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) |
| 1290 ((stencils |
| 1291 . ,(make-central-column-hole-addresses |
| 1292 CENTRAL-COLUMN-HOLE-H-LIST)) |
| 1293 (xy-scale-function . (,identity . ,identity)) |
| 1294 (textual? . #f) |
| 1295 (offset . (0.0 . 0.0))) |
| 1296 ((stencils . ,(make-left-hand-key-addresses '(III I))) |
| 1297 (textual? . ,lh-woodwind-text-stencil) |
| 1298 (offset . (-2.8 . 7.0))) |
| 1299 ((stencils . ,(make-left-hand-key-addresses '(II))) |
| 1300 (textual? . ,lh-woodwind-text-stencil) |
| 1301 (offset . (2.2 . 7.0))) |
| 1302 ((stencils |
| 1303 . ,(make-left-hand-key-addresses '(b |
| 1304 d |
| 1305 cis |
| 1306 gis |
| 1307 ees |
| 1308 low-b |
| 1309 bes |
| 1310 f))) |
| 1311 (textual? . ,lh-woodwind-text-stencil) |
| 1312 (offset . (1.5 . 3.75))) |
| 1313 ((stencils |
| 1314 . ,(make-right-hand-key-addresses |
| 1315 '(a gis d f banana c cis ees))) |
| 1316 (textual? . ,rh-woodwind-text-stencil) |
| 1317 (offset . (-1.25 . 0.0))))) |
| 1318 (xy-scale-function . (,identity . ,identity)) |
| 1319 (textual? . #f) |
| 1320 (offset . (0.0 . 0.0)))) |
| 1321 (draw-instructions |
| 1322 . ((,apply-group-draw-rule-series |
| 1323 (,(make-left-hand-key-addresses '(b d cis gis ees low-b bes f)) |
| 1324 ,(make-left-hand-key-addresses '(III I)) |
| 1325 ,(make-right-hand-key-addresses '(a gis d f banana c cis ees)))) |
| 1326 (,group-automate-rule |
| 1327 ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) |
| 1328 (,group-automate-rule ((hidden . midline))))) |
| 1329 (extra-offset-instructions |
| 1330 . ((,rich-group-extra-offset-rule |
| 1331 ((central-column . h)) |
| 1332 ((central-column . one)) |
| 1333 (0.0 . 0.8)) |
| 1334 (,uniform-extra-offset-rule (0.0 . 0.0)))))))))) |
| 1335 |
| 1336 ;;; Clarinet family stencils |
| 1337 |
| 1338 (define clarinet-lh-thumb-key-stencil |
| 1339 (variable-column-circle-stencil 0.9)) |
| 1340 |
| 1341 (define clarinet-lh-R-key-stencil |
| 1342 (let* ((halfbase (cos (/ PI 10))) |
| 1343 (height (* |
| 1344 halfbase |
| 1345 (/ (sin (/ (* 4 PI) 10)) (cos (/ (* 4 PI) 10)))))) |
| 1346 (standard-mcs-stencil |
| 1347 `( |
| 1348 (0 ,(/ -4.0 3.0) -2.0 ,(/ -4.0 3.0) -2.0 0.0) |
| 1349 (-1.5 ,(* 0.5 height) -1.25 ,(* 0.75 height) -1.0 ,height) |
| 1350 (-0.75 ,(* 0.75 height) -0.5 ,(* 0.5 height) 0.0 0.0)) |
| 1351 0.9 |
| 1352 0.9))) |
| 1353 |
| 1354 (define (clarinet-lh-a-key-stencil radius thick fill layout props) |
| 1355 (let* ((width 0.4) (height 0.75) (linelen 0.45)) |
| 1356 (ly:stencil-add |
| 1357 ((standard-e-stencil width height) radius thick fill layout props) |
| 1358 (ly:stencil-translate |
| 1359 (make-line-stencil thick 0 0 0 (* linelen radius)) |
| 1360 (cons 0 (* height radius)))))) |
| 1361 |
| 1362 (define clarinet-lh-gis-key-stencil (upper-key-stencil 0.0 0.0 1.3 2.0)) |
| 1363 |
| 1364 (define clarinet-lh-ees-key-stencil little-elliptical-key-stencil) |
| 1365 |
| 1366 (define clarinet-lh-cis-key-stencil oboe-lh-gis-key-stencil) |
| 1367 |
| 1368 (define clarinet-lh-f-key-stencil oboe-lh-low-b-key-stencil) |
| 1369 |
| 1370 (define clarinet-lh-e-key-stencil oboe-lh-ees-key-stencil) |
| 1371 |
| 1372 (define clarinet-lh-fis-key-stencil oboe-lh-bes-key-stencil) |
| 1373 |
| 1374 (define clarinet-lh-d-key-stencil (standard-e-stencil 1.0 0.4)) |
| 1375 |
| 1376 (define clarinet-rh-low-c-key-stencil |
| 1377 (standard-mcs-stencil |
| 1378 '((0.0 1.5) |
| 1379 (0.0 2.5 -1.0 2.5 -1.0 0.75) |
| 1380 (-1.0 0.1 0.0 0.25 0.0 0.3) |
| 1381 (0.0 0.0)) |
| 1382 0.8 |
| 1383 0.8)) |
| 1384 |
| 1385 (define clarinet-rh-low-cis-key-stencil |
| 1386 (standard-mcs-stencil |
| 1387 '((0.0 1.17) |
| 1388 (0.0 1.67 -1.0 1.67 -1.0 0.92) |
| 1389 (-1.0 0.47 0.0 0.52 0.0 0.62) |
| 1390 (0.0 0.0)) |
| 1391 0.8 |
| 1392 0.8)) |
| 1393 |
| 1394 (define clarinet-rh-low-d-key-stencil |
| 1395 (standard-mcs-stencil |
| 1396 '((0.0 1.05) |
| 1397 (0.0 1.55 -1.0 1.55 -1.0 0.8) |
| 1398 (-1.0 0.35 0.0 0.4 0.0 0.5) |
| 1399 (0.0 0.0)) |
| 1400 0.8 |
| 1401 0.8)) |
| 1402 |
| 1403 (define clarinet-rh-one-key-stencil (standard-e-stencil 0.5 0.25)) |
| 1404 |
| 1405 (define clarinet-rh-two-key-stencil clarinet-rh-one-key-stencil) |
| 1406 |
| 1407 (define clarinet-rh-three-key-stencil clarinet-rh-one-key-stencil) |
| 1408 |
| 1409 (define clarinet-rh-four-key-stencil clarinet-rh-one-key-stencil) |
| 1410 |
| 1411 (define clarinet-rh-b-key-stencil little-elliptical-key-stencil) |
| 1412 |
| 1413 ; cl low-rh values |
| 1414 (define CL-RH-HAIR 0.09) |
| 1415 (define CL-RH-H-STRETCH 2.7) |
| 1416 (define CL-RH-V-STRETCH 0.9) |
| 1417 |
| 1418 ; TODO |
| 1419 ; there is some unnecessary information duplication here. |
| 1420 ; need a way to control all of the below stencils so that if one |
| 1421 ; changes, all change... |
| 1422 |
| 1423 (define clarinet-rh-fis-key-stencil |
| 1424 (standard-mcs-stencil |
| 1425 `(,(bezier-head-for-stencil |
| 1426 '((0.0 . 0.0) (0.0 . -1.0) (1.0 . -1.0) (1.0 . 0.0)) |
| 1427 0.5) |
| 1428 ,(bezier-head-for-stencil |
| 1429 '((0.5 . -0.75) (0.5 . 0.25) (1.5 . 0.25) (1.5 . -0.75)) |
| 1430 0.5) |
| 1431 (1.0 1.0 0.0 1.0 0.0 0.0)) |
| 1432 CL-RH-H-STRETCH |
| 1433 CL-RH-V-STRETCH)) |
| 1434 |
| 1435 (define clarinet-rh-e-key-stencil |
| 1436 (standard-mcs-stencil |
| 1437 '((0.0 1.0 1.0 1.0 1.0 0.0) (1.0 -1.0 0.0 -1.0 0.0 0.0)) |
| 1438 CL-RH-H-STRETCH |
| 1439 CL-RH-V-STRETCH)) |
| 1440 |
| 1441 (define clarinet-rh-ees-key-stencil |
| 1442 (standard-mcs-stencil |
| 1443 `(,(bezier-head-for-stencil |
| 1444 '((0.0 . 0.0) (0.0 . -1.0) (1.0 . -1.0) (1.0 . 0.0)) |
| 1445 0.5) |
| 1446 ,(bezier-head-for-stencil |
| 1447 '((0.5 . -0.75) (0.5 . 0.25) (1.5 . 0.25) (1.5 . -0.75)) |
| 1448 0.5) |
| 1449 ,(bezier-head-for-stencil |
| 1450 `((1.0 . 0.0) (,(/ 1 3) . 0.0) (,(/ 1 3) . 1.5) (1.0 . 1.5)) |
| 1451 0.5) |
| 1452 ,(bezier-head-for-stencil |
| 1453 `((0.5 . 0.75) (,(/ -1 6) . 0.75) (,(/ -1 6) . -0.75) (0.5 . -0.75)) |
| 1454 0.5)) |
| 1455 CL-RH-H-STRETCH |
| 1456 CL-RH-V-STRETCH)) |
| 1457 |
| 1458 (define clarinet-rh-gis-key-stencil clarinet-rh-e-key-stencil) |
| 1459 |
| 1460 (define bass-clarinet-rh-f-key-stencil |
| 1461 (standard-mcs-stencil |
| 1462 `(,(bezier-head-for-stencil |
| 1463 '((0.0 . 0.0) (0.0 . -1.0) (1.0 . -1.0) (1.0 . 0.0)) |
| 1464 0.5) |
| 1465 ,(bezier-head-for-stencil |
| 1466 '((0.5 . -0.75) (0.5 . 0.25) (1.5 . 0.25) (1.5 . -0.75)) |
| 1467 0.5) |
| 1468 (1.0 1.0 0.0 1.0 0.0 0.0)) |
| 1469 CL-RH-H-STRETCH |
| 1470 (- CL-RH-V-STRETCH))) |
| 1471 |
| 1472 (define low-bass-clarinet-rh-f-key-stencil clarinet-rh-ees-key-stencil) |
| 1473 |
| 1474 (define clarinet-rh-d-key-stencil clarinet-rh-e-key-stencil) |
| 1475 |
| 1476 (define clarinet-change-points |
| 1477 ((make-named-spreadsheet '(clarinet bass-clarinet low-bass-clarinet)) |
| 1478 `((bottom-group-key-names |
| 1479 . (() |
| 1480 ((f |
| 1481 . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR)))) |
| 1482 (stencil . ,bass-clarinet-rh-f-key-stencil) |
| 1483 (text? . ("F" . #f)) |
| 1484 (complexity . trill)))) |
| 1485 ((f |
| 1486 . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR)))) |
| 1487 (stencil . ,low-bass-clarinet-rh-f-key-stencil) |
| 1488 (text? . ("F" . #f)) |
| 1489 (complexity . trill))) |
| 1490 (d |
| 1491 . ((offset . (,(+ 1.5 CL-RH-HAIR) . ,(* -1 (+ 0.75 CL-RH-HAIR)))) |
| 1492 (stencil . ,clarinet-rh-d-key-stencil) |
| 1493 (text? . ("d" . #f)) |
| 1494 (complexity . trill))) |
| 1495 (low-cis |
| 1496 . ((offset . (0.0 . 1.4)) |
| 1497 (stencil . ,clarinet-rh-low-cis-key-stencil) |
| 1498 (text? . ("c" . 1)) |
| 1499 (complexity . trill))) |
| 1500 (low-d |
| 1501 . ((offset . (0.0 . 2.4)) |
| 1502 (stencil . ,clarinet-rh-low-d-key-stencil) |
| 1503 (text? . ("d" . #f)) |
| 1504 (complexity . trill))) |
| 1505 (low-c |
| 1506 . ((offset . (0.0 . 0.0)) |
| 1507 (stencil . ,clarinet-rh-low-c-key-stencil) |
| 1508 (text? . ("c" . #f)) |
| 1509 (complexity . trill)))))) |
| 1510 (left-extra-key-names |
| 1511 . (() |
| 1512 () |
| 1513 ((d |
| 1514 . ((offset . (4.0 . -0.8)) |
| 1515 (stencil . ,clarinet-lh-d-key-stencil) |
| 1516 (text? . ("D" . #f)) |
| 1517 (complexity . trill)))))) |
| 1518 (right-thumb-group |
| 1519 . (() |
| 1520 () |
| 1521 (((stencils |
| 1522 . ,(make-right-hand-key-addresses '(low-c low-cis))) |
| 1523 (xy-scale-function . (,return-1 . ,return-1)) |
| 1524 (textual? . #f) |
| 1525 (offset . (-1.3 . 4.0)))))) |
| 1526 (low-left-hand-key-addresses |
| 1527 . (,(make-left-hand-key-addresses '(cis f e fis)) |
| 1528 ,(make-left-hand-key-addresses '(cis f e fis)) |
| 1529 ,(make-left-hand-key-addresses '(cis f e fis d)))) |
| 1530 (all-left-hand-key-addresses |
| 1531 . (,(make-left-hand-key-addresses '(a gis ees cis f e fis)) |
| 1532 ,(make-left-hand-key-addresses '(a gis ees cis f e fis)) |
| 1533 ,(make-left-hand-key-addresses '(a gis ees cis f e fis d)))) |
| 1534 (low-key-group |
| 1535 . (() |
| 1536 () |
| 1537 (,(make-right-hand-key-addresses '(low-c low-cis))))) |
| 1538 (low-rich-draw-rules |
| 1539 . (() |
| 1540 () |
| 1541 ((,rich-group-draw-rule |
| 1542 ((left-hand . d)) |
| 1543 ,(make-left-hand-key-addresses '(cis f e fis))) |
| 1544 (,rich-group-draw-rule |
| 1545 ((right-hand . low-d)) |
| 1546 ((right-hand . low-cis) (right-hand . low-c)))))) |
| 1547 (low-extra-offset-rule |
| 1548 . (() |
| 1549 () |
| 1550 ((,rich-group-extra-offset-rule |
| 1551 ,(make-right-hand-key-addresses '(low-c low-d low-cis)) |
| 1552 ,(make-right-hand-key-addresses '(one two three four)) |
| 1553 (-0.5 . -0.7))))) |
| 1554 (bottom-right-group-key-addresses |
| 1555 . (,(make-right-hand-key-addresses '(fis e ees gis)) |
| 1556 ,(make-right-hand-key-addresses '(fis e ees gis f)) |
| 1557 ,(make-right-hand-key-addresses '(fis e ees gis f d)))) |
| 1558 (right-hand-key-addresses |
| 1559 . (,(make-right-hand-key-addresses '(fis e ees gis)) |
| 1560 ,(make-right-hand-key-addresses '(fis e ees gis f)) |
| 1561 ,(make-right-hand-key-addresses |
| 1562 '(low-d low-cis low-c fis e ees gis f d))))))) |
| 1563 |
| 1564 (define (generate-clarinet-family-entry clarinet-name) |
| 1565 (let* |
| 1566 ((change-points |
| 1567 (get-named-spreadsheet-column clarinet-name clarinet-change-points))) |
| 1568 `(,clarinet-name |
| 1569 . ((keys |
| 1570 . ((hidden |
| 1571 . ((midline |
| 1572 . ((offset . (0.0 . 0.0)) |
| 1573 (stencil . ,midline-stencil) |
| 1574 (text? . #f) |
| 1575 (complexity . basic))))) |
| 1576 (central-column |
| 1577 . ((one |
| 1578 . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1579 (stencil . ,column-circle-stencil) |
| 1580 (text? . #f) |
| 1581 (complexity . covered))) |
| 1582 (two |
| 1583 . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1584 (stencil . ,column-circle-stencil) |
| 1585 (text? . #f) |
| 1586 (complexity . covered))) |
| 1587 (three |
| 1588 . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1589 (stencil . ,column-circle-stencil) |
| 1590 (text? . #f) |
| 1591 (complexity . covered))) |
| 1592 (four |
| 1593 . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1594 (stencil . ,column-circle-stencil) |
| 1595 (text? . #f) |
| 1596 (complexity . covered))) |
| 1597 (five |
| 1598 . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1599 (stencil . ,column-circle-stencil) |
| 1600 (text? . #f) |
| 1601 (complexity . covered))) |
| 1602 (six |
| 1603 . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1604 (stencil . ,column-circle-stencil) |
| 1605 (text? . #f) |
| 1606 (complexity . covered))) |
| 1607 (h |
| 1608 . ((offset . (0.0 . 6.25)) |
| 1609 (stencil . ,(variable-column-circle-stencil 0.4)) |
| 1610 (text? . #f) |
| 1611 (complexity . covered))))) |
| 1612 (left-hand |
| 1613 . ,(append `((thumb |
| 1614 . ((offset . (0.0 . 0.0)) |
| 1615 (stencil . ,clarinet-lh-thumb-key-stencil) |
| 1616 (text? . #f) |
| 1617 (complexity . trill))) |
| 1618 (R |
| 1619 . ((offset . (1.0 . 1.0)) |
| 1620 (stencil . ,clarinet-lh-R-key-stencil) |
| 1621 (text? . #f) |
| 1622 (complexity . trill))) |
| 1623 (a |
| 1624 . ((offset . (0.0 . 0.0)) |
| 1625 (stencil . ,clarinet-lh-a-key-stencil) |
| 1626 (text? . ("A" . #f)) |
| 1627 (complexity . trill))) |
| 1628 (gis |
| 1629 . ((offset . (0.8 . 1.0)) |
| 1630 (stencil . ,clarinet-lh-gis-key-stencil) |
| 1631 (text? . ("G" . 1)) |
| 1632 (complexity . trill))) |
| 1633 (ees |
| 1634 . ((offset . (0.0 . 0.0)) |
| 1635 (stencil . ,clarinet-lh-ees-key-stencil) |
| 1636 (text? . ("E" . 0)) |
| 1637 (complexity . trill))) |
| 1638 (cis |
| 1639 . ((offset . (-0.85 . 0.2)) |
| 1640 (stencil . ,clarinet-lh-cis-key-stencil) |
| 1641 (text? . ("C" . 1)) |
| 1642 (complexity . trill))) |
| 1643 (f |
| 1644 . ((offset . (3.6 . 0.5)) |
| 1645 (stencil . ,clarinet-lh-f-key-stencil) |
| 1646 (text? . ("F" . #f)) |
| 1647 (complexity . trill))) |
| 1648 (e |
| 1649 . ((offset . (2.05 . -3.65)) |
| 1650 (stencil . ,clarinet-lh-e-key-stencil) |
| 1651 (text? . ("E" . #f)) |
| 1652 (complexity . trill))) |
| 1653 (fis |
| 1654 . ((offset . (2.25 . -4.15)) |
| 1655 (stencil . ,clarinet-lh-fis-key-stencil) |
| 1656 (text? . ("F" . 1)) |
| 1657 (complexity . trill)))) |
| 1658 (assoc-get 'left-extra-key-names change-points))) |
| 1659 (right-hand |
| 1660 . ,(append `((one |
| 1661 . ((offset . (0.0 . 0.75)) |
| 1662 (stencil . ,clarinet-rh-one-key-stencil) |
| 1663 (text? . "1") |
| 1664 (complexity . trill))) |
| 1665 (two |
| 1666 . ((offset . (0.0 . 0.25)) |
| 1667 (stencil . ,clarinet-rh-two-key-stencil) |
| 1668 (text? . "2") |
| 1669 (complexity . trill))) |
| 1670 (three |
| 1671 . ((offset . (0.0 . -0.25)) |
| 1672 (stencil . ,clarinet-rh-three-key-stencil) |
| 1673 (text? . "3") |
| 1674 (complexity . trill))) |
| 1675 (four |
| 1676 . ((offset . (0.0 . -0.75)) |
| 1677 (stencil . ,clarinet-rh-four-key-stencil) |
| 1678 (text? . "4") |
| 1679 (complexity . trill))) |
| 1680 (b |
| 1681 . ((offset . (0.0 . 0.0)) |
| 1682 (stencil . ,clarinet-rh-b-key-stencil) |
| 1683 (text? . ("B" . #f)) |
| 1684 (complexity . trill))) |
| 1685 (fis |
| 1686 . ((offset . (0.0 . ,(* 4 (+ 0.75 CL-RH-HAIR)))) |
| 1687 (stencil . ,clarinet-rh-fis-key-stencil) |
| 1688 (text? . ("F" . 1)) |
| 1689 (complexity . trill))) |
| 1690 (e |
| 1691 . ((offset . (,(+ 1.5 CL-RH-HAIR) |
| 1692 . ,(* 3 (+ 0.75 CL-RH-HAIR)))) |
| 1693 (stencil . ,clarinet-rh-e-key-stencil) |
| 1694 (text? . ("E" . #f)) |
| 1695 (complexity . trill))) |
| 1696 (ees |
| 1697 . ((offset . (0.0 . ,(* 2 (+ 0.75 CL-RH-HAIR)))) |
| 1698 (stencil . ,clarinet-rh-ees-key-stencil) |
| 1699 (text? . ("E" . 0)) |
| 1700 (complexity . trill))) |
| 1701 (gis |
| 1702 . ((offset . (,(+ 1.5 CL-RH-HAIR) |
| 1703 . ,(* 1 (+ 0.75 CL-RH-HAIR)))) |
| 1704 (stencil . ,clarinet-rh-gis-key-stencil) |
| 1705 (text? . ("G" . 1)) |
| 1706 (complexity . trill)))) |
| 1707 (assoc-get 'bottom-group-key-names change-points))))) |
| 1708 (graphical-commands |
| 1709 . ((stencil-alist |
| 1710 . ((stencils |
| 1711 . ,(append (assoc-get 'right-thumb-group change-points) |
| 1712 `(,(simple-stencil-alist '(hidden . midline) |
| 1713 '(0.0 . 3.75)) |
| 1714 ((stencils |
| 1715 . ,(make-central-column-hole-addresses |
| 1716 CENTRAL-COLUMN-HOLE-H-LIST)) |
| 1717 (xy-scale-function . (,identity . ,identity)) |
| 1718 (textual? . #f) |
| 1719 (offset . (0.0 . 0.0))) |
| 1720 ((stencils |
| 1721 . ,(make-left-hand-key-addresses '(thumb R))) |
| 1722 (xy-scale-function . (,identity . ,identity)) |
| 1723 (textual? . #f) |
| 1724 (offset . (-2.5 . 6.5))) |
| 1725 ((stencils |
| 1726 . ((left-hand . a) (left-hand . gis))) |
| 1727 (xy-scale-function . (,return-1 . ,return-1)) |
| 1728 (textual? . #f) |
| 1729 (offset . (0.0 . 7.5))) |
| 1730 ,(simple-stencil-alist '(left-hand . ees) |
| 1731 '(1.0 . 5.0)) |
| 1732 ((stencils |
| 1733 . ,(make-left-hand-key-addresses '(cis f e fis))) |
| 1734 (xy-scale-function . (,return-1 . ,return-1)) |
| 1735 (textual? . #f) |
| 1736 (offset . (0.0 . 3.9))) |
| 1737 ((stencils |
| 1738 . ,(make-right-hand-key-addresses |
| 1739 '(one two three four))) |
| 1740 (xy-scale-function . (,return-1 . ,return-1)) |
| 1741 (textual? . #f) |
| 1742 (offset . (-1.25 . 3.75))) |
| 1743 ,(simple-stencil-alist '(right-hand . b) |
| 1744 '(-1.0 . 1.5)) |
| 1745 ((stencils |
| 1746 . ,(assoc-get 'bottom-right-group-key-addresses |
| 1747 change-points)) |
| 1748 (xy-scale-function . (,return-1 . ,return-1)) |
| 1749 (textual? . #f) |
| 1750 (offset . (-4.0 . -0.75)))))) |
| 1751 (xy-scale-function . (,identity . ,identity)) |
| 1752 (textual? . #f) |
| 1753 (offset . (0.0 . 0.0)))) |
| 1754 (draw-instructions |
| 1755 . ,(append (assoc-get 'low-rich-draw-rules change-points) |
| 1756 `((,apply-group-draw-rule-series |
| 1757 ,(append (assoc-get 'low-key-group change-points) |
| 1758 `(((left-hand . a) (left-hand . gis)) |
| 1759 ,(make-right-hand-key-addresses |
| 1760 '(one two three four)) |
| 1761 ,(assoc-get 'low-left-hand-key-addresses |
| 1762 change-points) |
| 1763 ,(assoc-get 'right-hand-key-addresses |
| 1764 change-points)))) |
| 1765 (,rich-group-draw-rule |
| 1766 ((left-hand . R)) |
| 1767 ((left-hand . thumb))) |
| 1768 (,group-automate-rule |
| 1769 ,(make-central-column-hole-addresses |
| 1770 CENTRAL-COLUMN-HOLE-LIST)) |
| 1771 (,group-automate-rule ((hidden . midline)))))) |
| 1772 (extra-offset-instructions |
| 1773 . ,(append (assoc-get 'low-extra-offset-rule change-points) |
| 1774 `((,rich-group-extra-offset-rule |
| 1775 ((central-column . h)) |
| 1776 ((central-column . one) |
| 1777 (left-hand . a) |
| 1778 (left-hand . gis)) |
| 1779 (0.0 . 0.8)) |
| 1780 (,uniform-extra-offset-rule (0.0 . 0.0))))))) |
| 1781 (text-commands |
| 1782 . ((stencil-alist |
| 1783 . ((stencils |
| 1784 . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) |
| 1785 ((stencils |
| 1786 . ,(make-central-column-hole-addresses |
| 1787 CENTRAL-COLUMN-HOLE-LIST)) |
| 1788 (xy-scale-function . (,identity . ,identity)) |
| 1789 (textual? . #f) |
| 1790 (offset . (0.0 . 0.0))) |
| 1791 ((stencils . ((left-hand . thumb) (left-hand . R))) |
| 1792 (xy-scale-function . (,identity . ,identity)) |
| 1793 (textual? . #f) |
| 1794 (offset . (-2.5 . 6.5))) |
| 1795 ((stencils |
| 1796 . ,(assoc-get 'all-left-hand-key-addresses change-points)) |
| 1797 (textual? . ,lh-woodwind-text-stencil) |
| 1798 (offset . (1.5 . 3.75))) |
| 1799 ((stencils |
| 1800 . ,(make-right-hand-key-addresses '(one two three four))) |
| 1801 (textual? . ,number-column-stencil) |
| 1802 (offset . (-1.25 . 3.75))) |
| 1803 ((stencils . ,(assoc-get 'right-hand-key-addresses |
| 1804 change-points)) |
| 1805 (textual? . ,rh-woodwind-text-stencil) |
| 1806 (offset . (-1.25 . 0.0))))) |
| 1807 (xy-scale-function . (,identity . ,identity)) |
| 1808 (textual? . #f) |
| 1809 (offset . (0.0 . 0.0)))) |
| 1810 (draw-instructions |
| 1811 . ((,apply-group-draw-rule-series |
| 1812 (,(assoc-get 'all-left-hand-key-addresses change-points) |
| 1813 ,(make-right-hand-key-addresses '(one two three four)) |
| 1814 ,(assoc-get 'right-hand-key-addresses change-points))) |
| 1815 (,group-automate-rule |
| 1816 ,(make-central-column-hole-addresses |
| 1817 CENTRAL-COLUMN-HOLE-LIST)) |
| 1818 (,group-automate-rule ((hidden . midline))))) |
| 1819 (extra-offset-instructions |
| 1820 . ((,rich-group-extra-offset-rule |
| 1821 ((central-column . h)) |
| 1822 ((central-column . one) (left-hand . a) (left-hand . gis)) |
| 1823 (0.0 . 0.8)) |
| 1824 (,uniform-extra-offset-rule (0.0 . 0.0)))))))))) |
| 1825 |
| 1826 ;;; Saxophone family stencils |
| 1827 |
| 1828 (define saxophone-lh-ees-key-stencil (upper-key-stencil 0.0 0.0 1.3 2.0)) |
| 1829 |
| 1830 (define saxophone-lh-f-key-stencil (upper-key-stencil 0.0 0.0 1.3 2.0)) |
| 1831 |
| 1832 (define saxophone-lh-d-key-stencil (upper-key-stencil 0.0 0.0 1.3 2.0)) |
| 1833 |
| 1834 (define saxophone-lh-front-f-key-stencil (standard-e-stencil 0.7 0.7)) |
| 1835 |
| 1836 (define saxophone-lh-bes-key-stencil (standard-e-stencil 0.5 0.5)) |
| 1837 |
| 1838 (define saxophone-lh-T-key-stencil (standard-e-stencil 0.75 0.75)) |
| 1839 |
| 1840 (define saxophone-lh-gis-key-stencil |
| 1841 (standard-mcs-stencil |
| 1842 '((0.0 0.4) |
| 1843 (0.0 0.8 3.0 0.8 3.0 0.4) |
| 1844 (3.0 0.0) |
| 1845 (3.0 -0.4 0.0 -0.4 0.0 0.0)) |
| 1846 0.8 |
| 1847 0.8)) |
| 1848 |
| 1849 (define (saxophone-lh-b-cis-key-stencil flip?) |
| 1850 (standard-mcs-stencil |
| 1851 '((0.0 1.0) |
| 1852 (0.4 1.0 0.8 0.9 1.35 0.8) |
| 1853 (1.35 0.0) |
| 1854 (0.0 0.0)) |
| 1855 (* (if flip? -1 1) 0.8) |
| 1856 0.8)) |
| 1857 |
| 1858 (define saxophone-lh-cis-key-stencil (saxophone-lh-b-cis-key-stencil #t)) |
| 1859 |
| 1860 (define saxophone-lh-b-key-stencil (saxophone-lh-b-cis-key-stencil #f)) |
| 1861 |
| 1862 (define saxophone-lh-low-bes-key-stencil |
| 1863 (standard-mcs-stencil |
| 1864 '((3.0 0.0) (3.0 -1.5 0.0 -1.5 0.0 0.0)) |
| 1865 0.8 |
| 1866 0.8)) |
| 1867 |
| 1868 (define (saxophone-rh-side-key-stencil width height) |
| 1869 (standard-mcs-stencil |
| 1870 `((0.0 ,height) |
| 1871 (0.05 ,(+ height 0.05) 0.1 ,(+ height 0.1) 0.15 ,(+ height 0.15)) |
| 1872 (,(- width 0.15) ,(+ height 0.15)) |
| 1873 (,(- width 0.1) |
| 1874 ,(+ height 0.1) |
| 1875 ,(- width 0.05) |
| 1876 ,(+ height 0.05) |
| 1877 ,width |
| 1878 ,height) |
| 1879 (,width 0.0) |
| 1880 (,(- width 0.05) -0.05 ,(- width 0.1) -0.1 ,(- width 0.15) -0.15) |
| 1881 (0.15 -0.15) |
| 1882 (0.1 -0.1 0.05 -0.05 0.0 0.0)) |
| 1883 1.0 |
| 1884 1.0)) |
| 1885 |
| 1886 (define saxophone-rh-e-key-stencil (saxophone-rh-side-key-stencil 0.9 1.2)) |
| 1887 |
| 1888 (define saxophone-rh-c-key-stencil (saxophone-rh-side-key-stencil 0.9 0.6)) |
| 1889 |
| 1890 (define saxophone-rh-bes-key-stencil (saxophone-rh-side-key-stencil 0.9 0.45)) |
| 1891 |
| 1892 (define saxophone-rh-high-fis-key-stencil |
| 1893 (standard-mcs-stencil |
| 1894 (append |
| 1895 '((0.0 1.0) (0.0 1.4 0.6 1.4 0.6 1.0) (0.6 0.0)) |
| 1896 (map |
| 1897 (lambda |
| 1898 (l) |
| 1899 (flatten-list |
| 1900 (map |
| 1901 (lambda |
| 1902 (x) |
| 1903 (coord-rotate x (atan (* -1 (/ PI 6))))) |
| 1904 l))) |
| 1905 '(((0.6 . -1.0)) |
| 1906 ((0.6 . -1.4) (0.0 . -1.4) (0.0 . -1.0)) |
| 1907 ((0.0 . 0.0))))) |
| 1908 0.75 |
| 1909 0.75)) |
| 1910 |
| 1911 (define saxophone-rh-fis-key-stencil (standard-e-stencil 1.0 0.5)) |
| 1912 |
| 1913 (define saxophone-rh-ees-key-stencil (standard-e-stencil 1.2 0.5)) |
| 1914 |
| 1915 (define saxophone-rh-low-c-key-stencil |
| 1916 (standard-mcs-stencil |
| 1917 '((3.0 0.0) (3.0 -1.5 0.0 -1.5 0.0 0.0)) |
| 1918 0.8 |
| 1919 0.8)) |
| 1920 |
| 1921 (define (saxophone-lh-low-a-key-stencil radius thick fill layout props) |
| 1922 (interpret-markup |
| 1923 layout |
| 1924 props |
| 1925 (make-general-align-markup |
| 1926 Y |
| 1927 DOWN |
| 1928 (make-concat-markup |
| 1929 (make-name-keylist |
| 1930 `(,(text-fill-translate fill)) |
| 1931 '(("lowA" . #f)) |
| 1932 (* 9 radius)))))) |
| 1933 |
| 1934 (define (saxophone-name-passerelle name) |
| 1935 (cond ((eqv? name 'saxophone) 'saxophone) |
| 1936 ((eqv? name 'soprano-saxophone) 'saxophone) |
| 1937 ((eqv? name 'alto-saxophone) 'saxophone) |
| 1938 ((eqv? name 'tenor-saxophone) 'saxophone) |
| 1939 ((eqv? name 'baritone-saxophone) 'baritone-saxophone))) |
| 1940 |
| 1941 (define saxophone-change-points |
| 1942 ((make-named-spreadsheet '(saxophone baritone-saxophone)) |
| 1943 `((low-a-key-definition |
| 1944 . (() |
| 1945 ((low-a |
| 1946 . ((offset . (0.0 . 0.0)) |
| 1947 (stencil . ,saxophone-lh-low-a-key-stencil) |
| 1948 (text? . #f) |
| 1949 (complexity . trill)))))) |
| 1950 (low-a-key-group |
| 1951 . (() |
| 1952 (,(simple-stencil-alist '(left-hand . low-a) '(-5.0 . 7.0))))) |
| 1953 (low-a-presence |
| 1954 . (() |
| 1955 ((left-hand . low-a)))) |
| 1956 (left-hand-key-names |
| 1957 . (,(make-right-hand-key-addresses |
| 1958 '(ees d f front-f bes gis cis b low-bes)) |
| 1959 ,(make-right-hand-key-addresses |
| 1960 '(ees d f front-f bes gis cis b low-bes low-a))))))) |
| 1961 |
| 1962 (define (generate-saxophone-family-entry saxophone-name) |
| 1963 (let* |
| 1964 ((change-points |
| 1965 (get-named-spreadsheet-column |
| 1966 (saxophone-name-passerelle saxophone-name) saxophone-change-points))) |
| 1967 `(,saxophone-name |
| 1968 . ((keys |
| 1969 . ((hidden |
| 1970 . ((midline |
| 1971 . ((offset . (0.0 . 0.0)) |
| 1972 (stencil . ,midline-stencil) |
| 1973 (text? . #f) |
| 1974 (complexity . basic))))) |
| 1975 (central-column |
| 1976 . ((one |
| 1977 . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1978 (stencil . ,column-circle-stencil) |
| 1979 (text? . #f) |
| 1980 (complexity . trill))) |
| 1981 (two |
| 1982 . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1983 (stencil . ,column-circle-stencil) |
| 1984 (text? . #f) |
| 1985 (complexity . trill))) |
| 1986 (three |
| 1987 . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1988 (stencil . ,column-circle-stencil) |
| 1989 (text? . #f) |
| 1990 (complexity . trill))) |
| 1991 (four |
| 1992 . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1993 (stencil . ,column-circle-stencil) |
| 1994 (text? . #f) |
| 1995 (complexity . trill))) |
| 1996 (five |
| 1997 . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 1998 (stencil . ,column-circle-stencil) |
| 1999 (text? . #f) |
| 2000 (complexity . trill))) |
| 2001 (six |
| 2002 . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 2003 (stencil . ,column-circle-stencil) |
| 2004 (text? . #f) |
| 2005 (complexity . trill))))) |
| 2006 (left-hand |
| 2007 . ,(append (assoc-get 'low-a-key-definition change-points) |
| 2008 `((T |
| 2009 . ((offset . (0.0 . 0.0)) |
| 2010 (stencil . ,saxophone-lh-T-key-stencil) |
| 2011 (text? . ("T" . #f)) |
| 2012 (complexity . trill))) |
| 2013 (ees |
| 2014 . ((offset . (0.4 . 1.6)) |
| 2015 (stencil . ,saxophone-lh-ees-key-stencil) |
| 2016 (text? . ("E" . 0)) |
| 2017 (complexity . trill))) |
| 2018 (d |
| 2019 . ((offset . (1.5 . 0.5)) |
| 2020 (stencil . ,saxophone-lh-d-key-stencil) |
| 2021 (text? . ("D" . #f)) |
| 2022 (complexity . trill))) |
| 2023 (f |
| 2024 . ((offset . (0.0 . 0.0)) |
| 2025 (stencil . ,saxophone-lh-f-key-stencil) |
| 2026 (text? . ("F" . #f)) |
| 2027 (complexity . trill))) |
| 2028 (front-f |
| 2029 . ((offset . (0.0 . 0.0)) |
| 2030 (stencil . ,saxophone-lh-front-f-key-stencil) |
| 2031 (text? . ("f" . #f)) |
| 2032 (complexity . trill))) |
| 2033 (bes |
| 2034 . ((offset . (0.0 . 0.0)) |
| 2035 (stencil . ,saxophone-lh-bes-key-stencil) |
| 2036 (text? . ("B" . 0)) |
| 2037 (complexity . trill))) |
| 2038 (gis |
| 2039 . ((offset . (0.0 . 1.1)) |
| 2040 (stencil . ,saxophone-lh-gis-key-stencil) |
| 2041 (text? . ("G" . 1)) |
| 2042 (complexity . trill))) |
| 2043 (cis |
| 2044 . ((offset . (2.4 . 0.0)) |
| 2045 (stencil . ,saxophone-lh-cis-key-stencil) |
| 2046 (text? . ("C" . 1)) |
| 2047 (complexity . trill))) |
| 2048 (b |
| 2049 . ((offset . (0.0 . 0.0)) |
| 2050 (stencil . ,saxophone-lh-b-key-stencil) |
| 2051 (text? . ("B" . #f)) |
| 2052 (complexity . trill))) |
| 2053 (low-bes |
| 2054 . ((offset . (0.0 . -0.2)) |
| 2055 (stencil . ,saxophone-lh-low-bes-key-stencil) |
| 2056 (text? . ("b" . 0)) |
| 2057 (complexity . trill)))))) |
| 2058 (right-hand |
| 2059 . ((e |
| 2060 . ((offset . (0.0 . 2.0)) |
| 2061 (stencil . ,saxophone-rh-e-key-stencil) |
| 2062 (text? . ("E" . #f)) |
| 2063 (complexity . trill))) |
| 2064 (c |
| 2065 . ((offset . (0.0 . 0.9)) |
| 2066 (stencil . ,saxophone-rh-c-key-stencil) |
| 2067 (text? . ("C" . #f)) |
| 2068 (complexity . trill))) |
| 2069 (bes |
| 2070 . ((offset . (0.0 . 0.0)) |
| 2071 (stencil . ,saxophone-rh-bes-key-stencil) |
| 2072 (text? . ("B" . 0)) |
| 2073 (complexity . trill))) |
| 2074 (high-fis |
| 2075 . ((offset . (0.0 . 0.0)) |
| 2076 (stencil . ,saxophone-rh-high-fis-key-stencil) |
| 2077 (text? . ("hF" . 1)) |
| 2078 (complexity . trill))) |
| 2079 (fis |
| 2080 . ((offset . (0.0 . 0.0)) |
| 2081 (stencil . ,saxophone-rh-fis-key-stencil) |
| 2082 (text? . ("F" . 1)) |
| 2083 (complexity . trill))) |
| 2084 (ees |
| 2085 . ((offset . (0.0 . 0.7)) |
| 2086 (stencil . ,saxophone-rh-ees-key-stencil) |
| 2087 (text? . ("E" . 0)) |
| 2088 (complexity . trill))) |
| 2089 (low-c |
| 2090 . ((offset . (-1.2 . -0.1)) |
| 2091 (stencil . ,saxophone-rh-low-c-key-stencil) |
| 2092 (text? . ("c" . #f)) |
| 2093 (complexity . trill))))))) |
| 2094 (graphical-commands |
| 2095 . ((stencil-alist |
| 2096 . ((stencils |
| 2097 . ,(append (assoc-get 'low-a-key-group change-points) |
| 2098 `(,(simple-stencil-alist '(hidden . midline) |
| 2099 '(0.0 . 3.75)) |
| 2100 ((stencils |
| 2101 . ,(make-central-column-hole-addresses |
| 2102 CENTRAL-COLUMN-HOLE-LIST)) |
| 2103 (xy-scale-function . (,identity . ,identity)) |
| 2104 (textual? . #f) |
| 2105 (offset . (0.0 . 0.0))) |
| 2106 ((stencils |
| 2107 . ,(make-left-hand-key-addresses '(ees d f))) |
| 2108 (xy-scale-function . (,return-1 . ,return-1)) |
| 2109 (textual? . #f) |
| 2110 (offset . (1.5 . 6.8))) |
| 2111 ,(simple-stencil-alist '(left-hand . front-f) |
| 2112 '(0.0 . 7.35)) |
| 2113 ,(simple-stencil-alist '(left-hand . T) |
| 2114 '(-2.2 . 6.5)) |
| 2115 ,(simple-stencil-alist '(left-hand . bes) |
| 2116 '(0.0 . 6.2)) |
| 2117 ((stencils |
| 2118 . ,(make-left-hand-key-addresses |
| 2119 '(gis cis b low-bes))) |
| 2120 (xy-scale-function . (,return-1 . ,return-1)) |
| 2121 (textual? . #f) |
| 2122 (offset . (1.2 . 3.5))) |
| 2123 ((stencils |
| 2124 . ,(make-right-hand-key-addresses '(e c bes))) |
| 2125 (xy-scale-function . (,return-1 . ,return-1)) |
| 2126 (textual? . #f) |
| 2127 (offset . (-2.3 . 3.4))) |
| 2128 ,(simple-stencil-alist '(right-hand . high-fis) |
| 2129 '(-1.8 . 2.5)) |
| 2130 ,(simple-stencil-alist '(right-hand . fis) |
| 2131 '(-1.5 . 1.5)) |
| 2132 ((stencils |
| 2133 . ,(make-right-hand-key-addresses '(ees low-c))) |
| 2134 (xy-scale-function . (,return-1 . ,return-1)) |
| 2135 (textual? . #f) |
| 2136 (offset . (-2.0 . 0.3)))))) |
| 2137 (xy-scale-function . (,identity . ,identity)) |
| 2138 (textual? . #f) |
| 2139 (offset . (0.0 . 0.0)))) |
| 2140 (draw-instructions |
| 2141 . ((,apply-group-draw-rule-series |
| 2142 (,(make-left-hand-key-addresses '(ees d f)) |
| 2143 ,(make-left-hand-key-addresses '(gis cis b low-bes)) |
| 2144 ,(make-right-hand-key-addresses '(e c bes)) |
| 2145 ,(make-right-hand-key-addresses '(ees low-c)))) |
| 2146 (,group-automate-rule |
| 2147 ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) |
| 2148 (,group-automate-rule ((hidden . midline))))) |
| 2149 (extra-offset-instructions |
| 2150 . ((,rich-group-extra-offset-rule |
| 2151 ((left-hand . bes)) |
| 2152 ,(append (assoc-get 'low-a-presence change-points) |
| 2153 '((central-column . one) |
| 2154 (left-hand . front-f) |
| 2155 (left-hand . T) |
| 2156 (left-hand . ees) |
| 2157 (left-hand . d) |
| 2158 (left-hand . f))) |
| 2159 (0.0 . 1.0)) |
| 2160 (,uniform-extra-offset-rule (0.0 . 0.0)))))) |
| 2161 (text-commands |
| 2162 . ((stencil-alist |
| 2163 . ((stencils |
| 2164 . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) |
| 2165 ((stencils |
| 2166 . ,(make-central-column-hole-addresses |
| 2167 CENTRAL-COLUMN-HOLE-LIST)) |
| 2168 (xy-scale-function . (,identity . ,identity)) |
| 2169 (textual? . #f) |
| 2170 (offset . (0.0 . 0.0))) |
| 2171 ,(simple-stencil-alist '(left-hand . T) '(-1.0 . 7.0)) |
| 2172 ((stencils |
| 2173 . ,(assoc-get 'left-hand-key-names change-points)) |
| 2174 (textual? . ,lh-woodwind-text-stencil) |
| 2175 (offset . (1.5 . 3.75))) |
| 2176 ((stencils |
| 2177 . ,(make-right-hand-key-addresses |
| 2178 '(e c bes high-fis fis ees low-c))) |
| 2179 (textual? . ,rh-woodwind-text-stencil) |
| 2180 (offset . (-1.25 . 0.0))))) |
| 2181 (xy-scale-function . (,identity . ,identity)) |
| 2182 (textual? . #f) |
| 2183 (offset . (0.0 . 0.0)))) |
| 2184 (draw-instructions |
| 2185 . ((,apply-group-draw-rule-series |
| 2186 (,(make-left-hand-key-addresses |
| 2187 '(ees d f front-f bes gis cis b low-bes)) |
| 2188 ,(make-right-hand-key-addresses |
| 2189 '(e c bes high-fis fis ees low-c)))) |
| 2190 (,group-automate-rule |
| 2191 ,(make-central-column-hole-addresses |
| 2192 CENTRAL-COLUMN-HOLE-LIST)) |
| 2193 (,group-automate-rule ((hidden . midline))))) |
| 2194 (extra-offset-instructions |
| 2195 . ((,uniform-extra-offset-rule (0.0 . 0.0)))))))))) |
| 2196 |
| 2197 ;;; Bassoon family stencils |
| 2198 |
| 2199 (define (bassoon-bend-info-maker height gap cut) |
| 2200 (let* ( |
| 2201 (first-bezier |
| 2202 (flatten-list |
| 2203 (car |
| 2204 (split-bezier |
| 2205 `((0.0 . ,(+ height gap)) |
| 2206 (0.0 . ,(+ height (+ gap 1.0))) |
| 2207 (1.0 . ,(+ height (+ gap 2.0))) |
| 2208 (2.0 . ,(+ height (+ gap 2.0)))) |
| 2209 cut)))) |
| 2210 (second-bezier |
| 2211 (flatten-list |
| 2212 (reverse |
| 2213 (car |
| 2214 (split-bezier |
| 2215 `((1.0 . ,height) |
| 2216 (1.0 . ,(+ 0.5 height)) |
| 2217 (1.5 . ,(+ 1.0 height)) |
| 2218 (2.0 . ,(+ 1.0 height))) |
| 2219 cut))))) |
| 2220 (slope-offset1 |
| 2221 (get-slope-offset |
| 2222 `(,(list-ref first-bezier 4) . ,(list-ref first-bezier 5)) |
| 2223 `(,(list-ref first-bezier 6) . ,(list-ref first-bezier 7)))) |
| 2224 (slope-offset2 |
| 2225 (get-slope-offset |
| 2226 `(,(list-ref second-bezier 0) . ,(list-ref second-bezier 1)) |
| 2227 `(,(list-ref second-bezier 2) . ,(list-ref second-bezier 3))))) |
| 2228 (list first-bezier second-bezier slope-offset1 slope-offset2))) |
| 2229 |
| 2230 (define |
| 2231 (make-tilted-portion |
| 2232 first-bezier |
| 2233 second-bezier |
| 2234 slope-offset1 |
| 2235 slope-offset2 |
| 2236 keylen |
| 2237 bezier?) |
| 2238 (append |
| 2239 `((,(+ keylen (list-ref first-bezier 6)) |
| 2240 ,(+ |
| 2241 (* |
| 2242 (car slope-offset1) |
| 2243 (+ keylen (list-ref first-bezier 6))) (cdr slope-offset1)))) |
| 2244 ((if bezier? (lambda (x) `(,(apply append x))) identity) |
| 2245 `((,(+ (+ keylen 1.75) (list-ref first-bezier 6)) |
| 2246 ,(+ |
| 2247 (* |
| 2248 (car slope-offset1) |
| 2249 (+ (+ keylen 1.75) (list-ref first-bezier 6))) |
| 2250 (cdr slope-offset1))) |
| 2251 (,(+ (+ keylen 1.75) (list-ref second-bezier 0)) |
| 2252 ,(+ |
| 2253 (* |
| 2254 (car slope-offset2) |
| 2255 (+ (+ keylen 1.75) (list-ref second-bezier 0))) |
| 2256 (cdr slope-offset2))) |
| 2257 (,(+ keylen (list-ref second-bezier 0)) |
| 2258 ,(+ |
| 2259 (* (car slope-offset2) (+ keylen (list-ref second-bezier 0))) |
| 2260 (cdr slope-offset2))))) |
| 2261 `(,(list-head second-bezier 2)))) |
| 2262 |
| 2263 (define (rich-bassoon-uber-key-stencil height gap cut keylen d1 d2 proc bezier?) |
| 2264 (let* ((info-list (bassoon-bend-info-maker height gap cut)) |
| 2265 (first-bezier (car info-list)) |
| 2266 (second-bezier (cadr info-list)) |
| 2267 (slope-offset1 (caddr info-list)) |
| 2268 (slope-offset2 (cadddr info-list))) |
| 2269 (rich-mcs-stencil |
| 2270 (append |
| 2271 `((0.0 ,(+ height gap)) |
| 2272 ,(list-tail first-bezier 2)) |
| 2273 (make-tilted-portion |
| 2274 first-bezier |
| 2275 second-bezier |
| 2276 slope-offset1 |
| 2277 slope-offset2 |
| 2278 keylen |
| 2279 bezier?) |
| 2280 `(,(list-tail second-bezier 2) |
| 2281 (1.0 0.0) |
| 2282 (0.0 0.0))) |
| 2283 d1 |
| 2284 d2 |
| 2285 proc))) |
| 2286 |
| 2287 (define (bassoon-uber-key-stencil height gap cut keylen d1 d2) |
| 2288 (rich-bassoon-uber-key-stencil height gap cut keylen d1 d2 identity #t)) |
| 2289 |
| 2290 (define bassoon-cc-one-key-stencil (standard-e-stencil 1.5 0.8)) |
| 2291 |
| 2292 (define bassoon-lh-he-key-stencil little-elliptical-key-stencil) |
| 2293 |
| 2294 (define bassoon-lh-hees-key-stencil little-elliptical-key-stencil) |
| 2295 |
| 2296 (define bassoon-lh-ees-key-stencil |
| 2297 (rich-e-stencil |
| 2298 1.2 |
| 2299 0.6 |
| 2300 (lambda (stencil) (ly:stencil-rotate stencil 30 0 0)))) |
| 2301 |
| 2302 (define bassoon-lh-cis-key-stencil |
| 2303 (rich-e-stencil |
| 2304 1.0 |
| 2305 0.5 |
| 2306 (lambda (stencil) (ly:stencil-rotate stencil 30 0 0)))) |
| 2307 |
| 2308 (define bassoon-lh-lbes-key-stencil |
| 2309 (bassoon-uber-key-stencil 1.0 0.5 0.7 0.5 0.6 -0.6)) |
| 2310 |
| 2311 (define bassoon-lh-lb-key-stencil |
| 2312 (bassoon-uber-key-stencil 2.0 0.5 0.9 1.2 0.6 -0.6)) |
| 2313 |
| 2314 (define bassoon-lh-lc-key-stencil |
| 2315 (rich-pe-stencil 1.0 1.0 135 315 identity)) |
| 2316 |
| 2317 (define bassoon-lh-ld-key-stencil |
| 2318 (standard-mcs-stencil |
| 2319 '((-0.8 4.0 1.4 4.0 0.6 0.0) |
| 2320 (0.5 -0.5 0.5 -0.8 0.6 -1.0) |
| 2321 (0.7 -1.2 0.8 -1.3 0.8 -1.8) |
| 2322 (0.5 -1.8) |
| 2323 (0.5 -1.4 0.4 -1.2 0.3 -1.1) |
| 2324 (0.2 -1.0 0.1 -0.5 0.0 0.0)) |
| 2325 1.0 |
| 2326 1.0)) |
| 2327 |
| 2328 (define bassoon-lh-d-flick-key-stencil |
| 2329 (let ((height 3.0)) |
| 2330 (standard-mcs-stencil |
| 2331 `((0.0 ,height) |
| 2332 (0.2 ,(+ height 1.6) 0.8 ,(+ height 1.8) 1.0 ,(+ height 1.8)) |
| 2333 (1.4 ,(+ height 1.8) 1.9 ,(+ height 1.3) 1.9 ,(+ height 1.0)) |
| 2334 (1.9 ,(+ height 0.7) 1.0 ,(+ height 0.4) 0.8 ,(+ height 0.3)) |
| 2335 (0.6 ,(+ height 0.2) 0.4 ,(+ height 0.1) 0.4 ,(- height 0.1)) |
| 2336 (0.4 0.0) |
| 2337 (0.0 0.0)) |
| 2338 -1.0 |
| 2339 -1.0))) |
| 2340 |
| 2341 (define bassoon-lh-c-flick-key-stencil |
| 2342 (let ((height 3.0)) |
| 2343 (standard-mcs-stencil |
| 2344 `((0.0 ,height) |
| 2345 (0.0 ,(+ height 1.6) 0.4 ,(+ height 1.8) 0.5 ,(+ height 1.8)) |
| 2346 (0.7 ,(+ height 1.8) 0.9 ,(+ height 1.3) 0.9 ,(+ height 1.0)) |
| 2347 (0.9 ,(+ height 0.5) 0.7 ,(+ height 0.4) 0.6 ,(+ height 0.3)) |
| 2348 (0.5 ,(+ height 0.2) 0.4 ,(+ height 0.1) 0.4 ,(- height 0.1)) |
| 2349 (0.4 0.0) |
| 2350 (0.0 0.0)) |
| 2351 -1.0 |
| 2352 -1.0))) |
| 2353 |
| 2354 (define bassoon-lh-a-flick-key-stencil |
| 2355 (bassoon-uber-key-stencil 5.0 1.0 0.3 0.6 -0.5 -0.5)) |
| 2356 |
| 2357 (define bassoon-lh-thumb-cis-key-stencil |
| 2358 (bassoon-uber-key-stencil 1.5 1.5 0.6 0.6 -0.6 0.6)) |
| 2359 |
| 2360 (define bassoon-lh-whisper-key-stencil (variable-column-circle-stencil 0.7)) |
| 2361 |
| 2362 (define bassoon-rh-cis-key-stencil |
| 2363 (rich-bassoon-uber-key-stencil |
| 2364 1.1 |
| 2365 1.5 |
| 2366 0.9 |
| 2367 0.3 |
| 2368 0.5 |
| 2369 0.5 |
| 2370 (lambda (stencil) (ly:stencil-rotate stencil -76 0 0)) |
| 2371 #t)) |
| 2372 |
| 2373 (define bassoon-rh-bes-key-stencil little-elliptical-key-stencil) |
| 2374 |
| 2375 (define bassoon-rh-fis-key-stencil |
| 2376 (rich-bassoon-uber-key-stencil 0.5 1.0 0.8 1.5 -0.7 0.7 identity #f)) |
| 2377 |
| 2378 (define bassoon-rh-f-key-stencil |
| 2379 (let* ((height 0.5) (gap 1.0) (cut 0.8) (keylen 1.5) |
| 2380 (info-list (bassoon-bend-info-maker height gap cut)) |
| 2381 (first-bezier (car info-list)) |
| 2382 (second-bezier (cadr info-list)) |
| 2383 (slope-offset1 (caddr info-list)) |
| 2384 (slope-offset2 (cadddr info-list))) |
| 2385 (standard-mcs-stencil |
| 2386 (append |
| 2387 (map |
| 2388 (lambda (l) |
| 2389 (rotunda-map |
| 2390 - |
| 2391 l |
| 2392 (list-tail first-bezier 6))) |
| 2393 (make-tilted-portion |
| 2394 first-bezier |
| 2395 second-bezier |
| 2396 slope-offset1 |
| 2397 slope-offset2 |
| 2398 keylen |
| 2399 #t)) |
| 2400 '((0.0 0.0))) |
| 2401 -0.7 |
| 2402 0.7))) |
| 2403 |
| 2404 (define bassoon-rh-gis-key-stencil |
| 2405 (bassoon-uber-key-stencil 0.3 1.0 0.8 1.0 -0.7 0.7)) |
| 2406 |
| 2407 (define bassoon-rh-thumb-bes-key-stencil |
| 2408 (bassoon-uber-key-stencil 1.0 1.0 0.9 1.0 0.7 0.7)) |
| 2409 |
| 2410 (define bassoon-rh-thumb-e-key-stencil (variable-column-circle-stencil 0.7)) |
| 2411 |
| 2412 (define bassoon-rh-thumb-fis-key-stencil |
| 2413 (bassoon-uber-key-stencil 1.0 1.2 0.9 1.0 0.7 0.7)) |
| 2414 |
| 2415 (define bassoon-rh-thumb-gis-key-stencil |
| 2416 (bassoon-uber-key-stencil 1.2 0.8 0.9 0.4 0.7 0.7)) |
| 2417 |
| 2418 (define bassoon-change-points |
| 2419 ((make-named-spreadsheet '(bassoon contrabassoon)) |
| 2420 `((left-hand-additional-keys . |
| 2421 (((a . |
| 2422 ((offset . (0.0 . -0.3)) |
| 2423 (stencil . ,bassoon-lh-a-flick-key-stencil) |
| 2424 (text? . ("A" . #f)) |
| 2425 (complexity . trill))) |
| 2426 (w . |
| 2427 ((offset . (0.0 . 0.0)) |
| 2428 (stencil . ,bassoon-lh-whisper-key-stencil) |
| 2429 (text? . ("w" . #f)) |
| 2430 (complexity . trill)))) |
| 2431 ())) |
| 2432 (right-hand-additional-keys . |
| 2433 (((cis . |
| 2434 ((offset . (0.0 . 0.0)) |
| 2435 (stencil . ,bassoon-rh-cis-key-stencil) |
| 2436 (text? . ("C" . 1)) |
| 2437 (complexity . trill))) |
| 2438 (thumb-gis . |
| 2439 ((offset . (0.0 . 0.0)) |
| 2440 (stencil . ,bassoon-rh-thumb-gis-key-stencil) |
| 2441 (text? . ("G" . 1)) |
| 2442 (complexity . trill)))) |
| 2443 ())) |
| 2444 (left-hand-flick-group . |
| 2445 (((left-hand . d) (left-hand . c) (left-hand . a)) |
| 2446 ((left-hand . d) (left-hand . c)))) |
| 2447 (left-hand-thumb-group . |
| 2448 (((left-hand . w) (left-hand . thumb-cis)) |
| 2449 ((left-hand . thumb-cis)))) |
| 2450 (cis-offset-instruction . |
| 2451 (((,rich-group-extra-offset-rule |
| 2452 ((right-hand . cis)) |
| 2453 ,(append |
| 2454 '((hidden . midline) (hidden . long-midline)) |
| 2455 (make-central-column-hole-addresses '(three two one)) |
| 2456 (make-left-hand-key-addresses |
| 2457 '(low-b low-bes low-c low-d d a c w thumb-cis |
| 2458 high-ees high-e cis ees))) |
| 2459 (0.0 . 0.9))) |
| 2460 ())) |
| 2461 (right-hand-lower-thumb-group . |
| 2462 (((right-hand . thumb-gis) (right-hand . thumb-fis)) |
| 2463 ((right-hand . thumb-fis)))) |
| 2464 (right-hand-cis-key . |
| 2465 ((,(simple-stencil-alist '(right-hand . cis) '(-2.3 . 3.22))) |
| 2466 ())) |
| 2467 (back-left-hand-key-addresses . |
| 2468 ((low-b low-bes low-c low-d d a c w thumb-cis) |
| 2469 (low-b low-bes low-c low-d d c thumb-cis))) |
| 2470 (front-right-hand-key-addresses . |
| 2471 ((cis bes fis f gis) (bes fis f gis))) |
| 2472 (back-right-hand-key-addresses . |
| 2473 ((thumb-bes thumb-gis thumb-e thumb-fis) |
| 2474 (thumb-bes thumb-e thumb-fis)))))) |
| 2475 |
| 2476 (define (generate-bassoon-family-entry bassoon-name) |
| 2477 (let* |
| 2478 ((change-points |
| 2479 (get-named-spreadsheet-column bassoon-name bassoon-change-points))) |
| 2480 `(,bassoon-name |
| 2481 . ((keys |
| 2482 . ((hidden |
| 2483 . ((midline |
| 2484 . ((offset . (0.0 . 0.0)) |
| 2485 (stencil . ,midline-stencil) |
| 2486 (text? . #f) |
| 2487 (complexity . basic))) |
| 2488 (long-midline |
| 2489 . ((offset . (0.0 . 0.0)) |
| 2490 (stencil . ,long-midline-stencil) |
| 2491 (text? . #f) |
| 2492 (complexity . basic))))) |
| 2493 (central-column |
| 2494 . ((one |
| 2495 . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 2496 (stencil . ,bassoon-cc-one-key-stencil) |
| 2497 (text? . #f) |
| 2498 (complexity . trill))) |
| 2499 (two |
| 2500 . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 2501 (stencil . ,ring-column-circle-stencil) |
| 2502 (text? . #f) |
| 2503 (complexity . ring))) |
| 2504 (three |
| 2505 . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 2506 (stencil . ,ring-column-circle-stencil) |
| 2507 (text? . #f) |
| 2508 (complexity . ring))) |
| 2509 (four |
| 2510 . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 2511 (stencil . ,ring-column-circle-stencil) |
| 2512 (text? . #f) |
| 2513 (complexity . ring))) |
| 2514 (five |
| 2515 . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 2516 (stencil . ,ring-column-circle-stencil) |
| 2517 (text? . #f) |
| 2518 (complexity . ring))) |
| 2519 (six |
| 2520 . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS)) |
| 2521 (stencil . ,ring-column-circle-stencil) |
| 2522 (text? . #f) |
| 2523 (complexity . ring))))) |
| 2524 (left-hand |
| 2525 . ,(append (assoc-get 'left-hand-additional-keys |
| 2526 change-points) |
| 2527 `((high-e |
| 2528 . ((offset . (0.0 . 0.0)) |
| 2529 (stencil . ,bassoon-lh-he-key-stencil) |
| 2530 (text? . ("hE" . #f)) |
| 2531 (complexity . trill))) |
| 2532 (high-ees |
| 2533 . ((offset . (0.0 . 0.0)) |
| 2534 (stencil . ,bassoon-lh-hees-key-stencil) |
| 2535 (text? . ("hE" . 0)) |
| 2536 (complexity . trill))) |
| 2537 (ees |
| 2538 . ((offset . (-1.0 . 1.0)) |
| 2539 (stencil . ,bassoon-lh-ees-key-stencil) |
| 2540 (text? . ("E" . 0)) |
| 2541 (complexity . trill))) |
| 2542 (cis |
| 2543 . ((offset . (0.0 . 0.0)) |
| 2544 (stencil . ,bassoon-lh-cis-key-stencil) |
| 2545 (text? . ("C" . 1)) |
| 2546 (complexity . trill))) |
| 2547 (low-bes |
| 2548 . ((offset . (0.0 . 0.0)) |
| 2549 (stencil . ,bassoon-lh-lbes-key-stencil) |
| 2550 (text? . ("b" . 0)) |
| 2551 (complexity . trill))) |
| 2552 (low-b |
| 2553 . ((offset . (-1.0 . -0.7)) |
| 2554 (stencil . ,bassoon-lh-lb-key-stencil) |
| 2555 (text? . ("b" . #f)) |
| 2556 (complexity . trill))) |
| 2557 (low-c |
| 2558 . ((offset . (0.0 . 0.0)) |
| 2559 (stencil . ,bassoon-lh-lc-key-stencil) |
| 2560 (text? . ("c" . #f)) |
| 2561 (complexity . trill))) |
| 2562 (low-d |
| 2563 . ((offset . (0.0 . 0.0)) |
| 2564 (stencil . ,bassoon-lh-ld-key-stencil) |
| 2565 (text? . ("d" . #f)) |
| 2566 (complexity . trill))) |
| 2567 (d |
| 2568 . ((offset . (-1.5 . 2.0)) |
| 2569 (stencil . ,bassoon-lh-d-flick-key-stencil) |
| 2570 (text? . ("D" . #f)) |
| 2571 (complexity . trill))) |
| 2572 (c |
| 2573 . ((offset . (-0.8 . 1.1)) |
| 2574 (stencil . ,bassoon-lh-c-flick-key-stencil) |
| 2575 (text? . ("C" . #f)) |
| 2576 (complexity . trill))) |
| 2577 (thumb-cis |
| 2578 . ((offset . (2.0 . -1.0)) |
| 2579 (stencil . ,bassoon-lh-thumb-cis-key-stencil) |
| 2580 (text? . ("C" . 1)) |
| 2581 (complexity . trill)))))) |
| 2582 (right-hand |
| 2583 . ,(append (assoc-get 'right-hand-additional-keys |
| 2584 change-points) |
| 2585 `((bes |
| 2586 . ((offset . (0.0 . 0.8)) |
| 2587 (stencil . ,bassoon-rh-bes-key-stencil) |
| 2588 (text? . ("B" . 0)) |
| 2589 (complexity . trill))) |
| 2590 (f |
| 2591 . ((offset . (-2.2 . 4.35)) |
| 2592 (stencil . ,bassoon-rh-f-key-stencil) |
| 2593 (text? . ("F" . #f)) |
| 2594 (complexity . trill))) |
| 2595 (fis |
| 2596 . ((offset . (1.5 . 1.0)) |
| 2597 (stencil . ,bassoon-rh-fis-key-stencil) |
| 2598 (text? . ("F" . 1)) |
| 2599 (complexity . trill))) |
| 2600 (gis |
| 2601 . ((offset . (0.0 . -0.15)) |
| 2602 (stencil . ,bassoon-rh-gis-key-stencil) |
| 2603 (text? . ("G" . 1)) |
| 2604 (complexity . trill))) |
| 2605 (thumb-bes |
| 2606 . ((offset . (0.0 . 0.0)) |
| 2607 (stencil . ,bassoon-rh-thumb-bes-key-stencil) |
| 2608 (text? . ("B" . 0)) |
| 2609 (complexity . trill))) |
| 2610 (thumb-e |
| 2611 . ((offset . (1.75 . 0.4)) |
| 2612 (stencil . ,bassoon-rh-thumb-e-key-stencil) |
| 2613 (text? . ("E" . #f)) |
| 2614 (complexity . trill))) |
| 2615 (thumb-fis |
| 2616 . ((offset . (-1.0 . 1.6)) |
| 2617 (stencil . ,bassoon-rh-thumb-fis-key-stencil) |
| 2618 (text? . ("F" . 1)) |
| 2619 (complexity . trill)))))))) |
| 2620 (graphical-commands |
| 2621 . ((stencil-alist |
| 2622 . ((stencils |
| 2623 . ,(append (assoc-get 'right-hand-cis-key change-points) |
| 2624 `(,(simple-stencil-alist '(hidden . midline) |
| 2625 '(0.0 . 3.75)) |
| 2626 ,(simple-stencil-alist '(hidden . long-midline) |
| 2627 '(0.0 . 3.80)) |
| 2628 ((stencils |
| 2629 . ,(make-central-column-hole-addresses |
| 2630 CENTRAL-COLUMN-HOLE-LIST)) |
| 2631 (xy-scale-function . (,identity . ,identity)) |
| 2632 (textual? . #f) |
| 2633 (offset . (0.0 . 0.0))) |
| 2634 ,(simple-stencil-alist '(left-hand . high-e) |
| 2635 '(-1.0 . 7.0)) |
| 2636 ,(simple-stencil-alist '(left-hand . high-ees) |
| 2637 '(-1.0 . 6.0)) |
| 2638 ((stencils |
| 2639 . ((left-hand . ees) (left-hand . cis))) |
| 2640 (xy-scale-function . (,return-1 . ,return-1)) |
| 2641 (textual? . #f) |
| 2642 (offset . (3.0 . 3.75))) |
| 2643 ((stencils |
| 2644 . (((stencils |
| 2645 . ((left-hand . low-b) |
| 2646 (left-hand . low-bes))) |
| 2647 (xy-scale-function |
| 2648 . (,return-1 . ,return-1)) |
| 2649 (textual? . #f) |
| 2650 (offset . (-2.0 . 9.0))) |
| 2651 ((stencils |
| 2652 . ,(assoc-get 'left-hand-flick-group |
| 2653 change-points)) |
| 2654 (xy-scale-function |
| 2655 . (,return-1 . ,return-1)) |
| 2656 (textual? . #f) |
| 2657 (offset . (3.0 . 7.0))) |
| 2658 ,(simple-stencil-alist '(left-hand . low-c) |
| 2659 '(-1.0 . 4.5)) |
| 2660 ,(simple-stencil-alist '(left-hand . low-d) |
| 2661 '(-1.0 . 0.1)) |
| 2662 ((stencils |
| 2663 . ,(assoc-get 'left-hand-thumb-group |
| 2664 change-points)) |
| 2665 (xy-scale-function |
| 2666 . (,return-1 . ,return-1)) |
| 2667 (textual? . #f) |
| 2668 (offset . (1.5 . -0.6))))) |
| 2669 (xy-scale-function . (,return-1 . ,return-1)) |
| 2670 (textual? . #f) |
| 2671 (offset . (-5.5 . 4.7))) |
| 2672 ,(simple-stencil-alist '(right-hand . bes) |
| 2673 '(1.0 . 1.2)) |
| 2674 ((stencils |
| 2675 . ,(make-right-hand-key-addresses '(gis f fis))) |
| 2676 (xy-scale-function . (,return-1 . ,return-1)) |
| 2677 (textual? . #f) |
| 2678 (offset . (2.0 . -1.25))) |
| 2679 ((stencils |
| 2680 . (((stencils |
| 2681 . ((right-hand . thumb-bes) |
| 2682 (right-hand . thumb-e))) |
| 2683 (xy-scale-function |
| 2684 . (,return-1 . ,return-1)) |
| 2685 (textual? . #f) |
| 2686 (offset . (-1.22 . 5.25))) |
| 2687 ((stencils |
| 2688 . ,(assoc-get 'right-hand-lower-thumb-group |
| 2689 change-points)) |
| 2690 (xy-scale-function |
| 2691 . (,return-1 . ,return-1)) |
| 2692 (textual? . #f) |
| 2693 (offset . (0.0 . 0.0))))) |
| 2694 (xy-scale-function |
| 2695 . (,return-1 . ,return-1)) |
| 2696 (textual? . #f) |
| 2697 (offset . (-5.0 . 0.0)))))) |
| 2698 (xy-scale-function . (,identity . ,identity)) |
| 2699 (textual? . #f) |
| 2700 (offset . (0.0 . 0.0)))) |
| 2701 (draw-instructions |
| 2702 . ((,apply-group-draw-rule-series |
| 2703 (,(make-left-hand-key-addresses '(ees cis)) |
| 2704 ,(make-left-hand-key-addresses |
| 2705 (assoc-get 'back-left-hand-key-addresses change-points)) |
| 2706 ,(make-right-hand-key-addresses '(f fis gis)) |
| 2707 ,(make-right-hand-key-addresses |
| 2708 (assoc-get 'back-right-hand-key-addresses change-points)))) |
| 2709 (,group-automate-rule |
| 2710 ,(make-central-column-hole-addresses |
| 2711 CENTRAL-COLUMN-HOLE-LIST)) |
| 2712 (,bassoon-midline-rule |
| 2713 ,(append |
| 2714 (make-left-hand-key-addresses |
| 2715 (assoc-get 'back-left-hand-key-addresses change-points)) |
| 2716 (make-right-hand-key-addresses |
| 2717 (assoc-get 'back-right-hand-key-addresses |
| 2718 change-points)))))) |
| 2719 (extra-offset-instructions |
| 2720 . ,(append |
| 2721 (assoc-get 'cis-offset-instruction change-points) |
| 2722 `((,uniform-extra-offset-rule (0.0 . 0.0))))))) |
| 2723 (text-commands |
| 2724 . ((stencil-alist |
| 2725 . ((stencils |
| 2726 . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) |
| 2727 ((stencils |
| 2728 . ,(make-central-column-hole-addresses |
| 2729 CENTRAL-COLUMN-HOLE-LIST)) |
| 2730 (xy-scale-function . (,identity . ,identity)) |
| 2731 (textual? . #f) |
| 2732 (offset . (0.0 . 0.0))) |
| 2733 ((stencils |
| 2734 . ,(make-left-hand-key-addresses |
| 2735 '(high-e high-ees ees cis))) |
| 2736 (textual? . ,lh-woodwind-text-stencil) |
| 2737 (offset . (1.5 . 3.75))) |
| 2738 ((stencils |
| 2739 . ,(make-left-hand-key-addresses |
| 2740 (assoc-get 'back-left-hand-key-addresses |
| 2741 change-points))) |
| 2742 (textual? . ,rh-woodwind-text-stencil) |
| 2743 (offset . (-1.25 . 3.75))) |
| 2744 ((stencils |
| 2745 . ,(make-right-hand-key-addresses |
| 2746 (assoc-get 'front-right-hand-key-addresses |
| 2747 change-points))) |
| 2748 (textual? . ,lh-woodwind-text-stencil) |
| 2749 (offset . (1.5 . 0.0))) |
| 2750 ((stencils . |
| 2751 ,(make-right-hand-key-addresses |
| 2752 (assoc-get 'back-right-hand-key-addresses |
| 2753 change-points))) |
| 2754 (textual? . ,rh-woodwind-text-stencil) |
| 2755 (offset . (-1.25 . 0.0))))) |
| 2756 (xy-scale-function . (,identity . ,identity)) |
| 2757 (textual? . #f) |
| 2758 (offset . (0.0 . 0.0)))) |
| 2759 (draw-instructions |
| 2760 . ((,apply-group-draw-rule-series |
| 2761 (,(make-left-hand-key-addresses |
| 2762 (assoc-get 'back-left-hand-key-addresses change-points)) |
| 2763 ,(make-right-hand-key-addresses |
| 2764 (assoc-get 'front-right-hand-key-addresses change-points)) |
| 2765 ,(make-right-hand-key-addresses |
| 2766 (assoc-get 'back-right-hand-key-addresses change-points)) |
| 2767 ,(make-left-hand-key-addresses '(high-e high-ees ees cis)))) |
| 2768 (,group-automate-rule |
| 2769 ,(make-central-column-hole-addresses |
| 2770 CENTRAL-COLUMN-HOLE-LIST)) |
| 2771 (,group-automate-rule ((hidden . midline))))) |
| 2772 (extra-offset-instructions |
| 2773 . ((,uniform-extra-offset-rule (0.0 . 0.0)))))))))) |
| 2774 |
| 2775 ;; Assembly functions |
| 2776 |
| 2777 ; Scans a bank for name. |
| 2778 ; for example, '(left-hand . bes) will return bes in the left-hand |
| 2779 ; of a given bank |
| 2780 (define (get-key name bank) |
| 2781 (assoc-get (cdr name) (assoc-get (car name) bank))) |
| 2782 |
| 2783 (define (translate-key-instruction key-instruction) |
| 2784 (let* |
| 2785 ((key-name (car key-instruction)) |
| 2786 (key-complexity (assoc-get 'complexity (cdr key-instruction)))) |
| 2787 (cond |
| 2788 ((eqv? key-complexity 'basic) |
| 2789 `((,key-name . ,(assoc-get 'F HOLE-FILL-LIST)))) |
| 2790 ((eqv? key-complexity 'trill) |
| 2791 (make-symbol-alist key-name #t #f)) |
| 2792 ((eqv? key-complexity 'covered) |
| 2793 (make-symbol-alist key-name #f #f)) |
| 2794 ((eqv? key-complexity 'ring) |
| 2795 (make-symbol-alist key-name #f #t))))) |
| 2796 |
| 2797 (define (update-possb-list input-key possibility-list canonic-list) |
| 2798 (if (null? possibility-list) |
| 2799 (ly:error "woodwind markup error - invalid key or hole requested") |
| 2800 (if |
| 2801 (assoc-get input-key (cdar possibility-list)) |
| 2802 (append |
| 2803 `(((,(caaar possibility-list) . |
| 2804 ,(assoc-get input-key (cdar possibility-list))) . |
| 2805 ,(assoc-get (caar possibility-list) canonic-list))) |
| 2806 (assoc-remove (caar possibility-list) canonic-list)) |
| 2807 (update-possb-list input-key (cdr possibility-list) canonic-list)))) |
| 2808 |
| 2809 (define (key-crawler input-list possibility-list) |
| 2810 (if (null? input-list) |
| 2811 (map car possibility-list) |
| 2812 (key-crawler |
| 2813 (cdr input-list) |
| 2814 (update-possb-list |
| 2815 (car input-list) |
| 2816 possibility-list |
| 2817 possibility-list)))) |
| 2818 |
| 2819 (define (translate-draw-instructions input-alist key-name-alist) |
| 2820 (apply append |
| 2821 (map |
| 2822 (lambda |
| 2823 (short long) |
| 2824 (let* |
| 2825 ((key-instructions |
| 2826 (map |
| 2827 (lambda |
| 2828 (instr) |
| 2829 `(((,long . ,(car instr)) . 0) . |
| 2830 ,(translate-key-instruction instr))) |
| 2831 (assoc-get long key-name-alist)))) |
| 2832 (key-crawler (assoc-get short input-alist) key-instructions))) |
| 2833 '(hd cc lh rh) |
| 2834 '(hidden central-column left-hand right-hand)))) |
| 2835 |
| 2836 (define (uniform-draw-instructions key-name-alist) |
| 2837 (apply append |
| 2838 (map |
| 2839 (lambda |
| 2840 (long) |
| 2841 (map |
| 2842 (lambda |
| 2843 (key-instructions) |
| 2844 `((,long . ,(car key-instructions)) . 1)) |
| 2845 (assoc-get long key-name-alist))) |
| 2846 '(hidden central-column left-hand right-hand)))) |
| 2847 |
| 2848 (define (list-all-possible-keys key-name-alist) |
| 2849 (map |
| 2850 (lambda |
| 2851 (short long) |
| 2852 `(,short . ,(map |
| 2853 (lambda |
| 2854 (key-instructions) |
| 2855 (car key-instructions)) |
| 2856 (assoc-get long key-name-alist)))) |
| 2857 '(cc lh rh) |
| 2858 '(central-column left-hand right-hand))) |
| 2859 |
| 2860 (define (list-all-possible-keys-verbose key-name-alist) |
| 2861 (map |
| 2862 (lambda |
| 2863 (short long) |
| 2864 `(,short . ,(map |
| 2865 (lambda |
| 2866 (key-instructions) |
| 2867 `(,(car key-instructions) . |
| 2868 ,(map |
| 2869 (lambda |
| 2870 (x) |
| 2871 (car x)) |
| 2872 (translate-key-instruction key-instructions)))) |
| 2873 (assoc-get long key-name-alist)))) |
| 2874 '(cc lh rh) |
| 2875 '(central-column left-hand right-hand))) |
| 2876 |
| 2877 (define woodwind-data-assembly-instructions |
| 2878 `((,generate-flute-family-entry . piccolo) |
| 2879 (,generate-flute-family-entry . flute) |
| 2880 (,generate-flute-family-entry . flute-b-extension) |
| 2881 (,generate-oboe-family-entry . oboe) |
| 2882 (,generate-clarinet-family-entry . clarinet) |
| 2883 (,generate-clarinet-family-entry . bass-clarinet) |
| 2884 (,generate-clarinet-family-entry . low-bass-clarinet) |
| 2885 (,generate-saxophone-family-entry . saxophone) |
| 2886 (,generate-saxophone-family-entry . soprano-saxophone) |
| 2887 (,generate-saxophone-family-entry . alto-saxophone) |
| 2888 (,generate-saxophone-family-entry . tenor-saxophone) |
| 2889 (,generate-saxophone-family-entry . baritone-saxophone) |
| 2890 (,generate-bassoon-family-entry . bassoon) |
| 2891 (,generate-bassoon-family-entry . contrabassoon))) |
| 2892 |
| 2893 (define-public woodwind-instrument-list |
| 2894 (map cdr woodwind-data-assembly-instructions)) |
| 2895 |
| 2896 (define woodwind-data-alist |
| 2897 (map |
| 2898 (lambda (instruction) |
| 2899 ((car instruction) (cdr instruction))) |
| 2900 woodwind-data-assembly-instructions)) |
| 2901 |
| 2902 ;;; The brains of the markup function: takes drawing and offset information |
| 2903 ;;; about a key region and calls the appropriate stencils to draw the region. |
| 2904 |
| 2905 |
| 2906 ; now that is unnested, need to find a way to feed info... |
| 2907 (define |
| 2908 (assemble-stencils |
| 2909 stencil-alist |
| 2910 key-bank |
| 2911 draw-instructions |
| 2912 extra-offset-instructions |
| 2913 radius |
| 2914 thick |
| 2915 xy-stretch |
| 2916 layout |
| 2917 props) |
| 2918 (apply |
| 2919 ly:stencil-add |
| 2920 (map |
| 2921 (lambda |
| 2922 (node) |
| 2923 (ly:stencil-translate |
| 2924 (if (pair? (cdr node)) |
| 2925 (if (assoc-get 'textual? node) |
| 2926 ((assoc-get 'textual? node) |
| 2927 (map |
| 2928 (lambda (key) (assoc-get 'text? key)) |
| 2929 (map |
| 2930 (lambda (instr) (get-key instr key-bank)) |
| 2931 (assoc-get 'stencils node))) |
| 2932 radius |
| 2933 (map |
| 2934 (lambda (key) (assoc-get key draw-instructions)) |
| 2935 (assoc-get 'stencils node)) |
| 2936 layout |
| 2937 props) |
| 2938 (assemble-stencils |
| 2939 node |
| 2940 key-bank |
| 2941 draw-instructions |
| 2942 extra-offset-instructions |
| 2943 radius |
| 2944 thick |
| 2945 (coord-apply |
| 2946 (assoc-get 'xy-scale-function stencil-alist) |
| 2947 xy-stretch) |
| 2948 layout |
| 2949 props)) |
| 2950 (if (= 0 (assoc-get node draw-instructions)) |
| 2951 empty-stencil |
| 2952 ((assoc-get 'stencil (get-key node key-bank)) |
| 2953 radius |
| 2954 thick |
| 2955 (assoc-get node draw-instructions) |
| 2956 layout |
| 2957 props))) |
| 2958 (coord-scale |
| 2959 (coord-translate |
| 2960 (coord-scale |
| 2961 (assoc-get |
| 2962 'offset |
| 2963 (if (pair? (cdr node)) |
| 2964 node |
| 2965 (get-key node key-bank))) |
| 2966 (coord-apply |
| 2967 (assoc-get 'xy-scale-function stencil-alist) |
| 2968 xy-stretch)) |
| 2969 (if |
| 2970 (assoc-get node extra-offset-instructions) |
| 2971 (assoc-get node extra-offset-instructions) |
| 2972 '(0.0 . 0.0))) |
| 2973 radius))) |
| 2974 (assoc-get 'stencils stencil-alist)))) |
| 2975 |
| 2976 (define-public (print-keys instrument) |
| 2977 (let* |
| 2978 ((chosen-instrument |
| 2979 (begin |
| 2980 (format #t "\nPrinting keys for: ~a\n" instrument) |
| 2981 (assoc-get instrument woodwind-data-alist))) |
| 2982 (key-list (list-all-possible-keys (assoc-get 'keys chosen-instrument)))) |
| 2983 (define (key-list-loop key-list) |
| 2984 (if (null? key-list) |
| 2985 0 |
| 2986 (begin |
| 2987 (format #t "~a\n ~a\n" (caar key-list) (cdar key-list)) |
| 2988 (key-list-loop (cdr key-list))))) |
| 2989 (key-list-loop key-list))) |
| 2990 |
| 2991 (define-public (get-woodwind-key-list instrument) |
| 2992 (list-all-possible-keys-verbose |
| 2993 (assoc-get |
| 2994 'keys |
| 2995 (assoc-get instrument woodwind-data-alist)))) |
| 2996 |
| 2997 (define-public (print-keys-verbose instrument) |
| 2998 (let* |
| 2999 ((chosen-instrument |
| 3000 (begin |
| 3001 (format #t "\nPrinting keys in verbose mode for: ~a\n" instrument) |
| 3002 (assoc-get instrument woodwind-data-alist))) |
| 3003 (key-list |
| 3004 (list-all-possible-keys-verbose (assoc-get 'keys chosen-instrument)))) |
| 3005 (define (key-list-loop key-list) |
| 3006 (if (null? key-list) |
| 3007 0 |
| 3008 (begin |
| 3009 (format #t "~a\n" (caar key-list)) |
| 3010 (map |
| 3011 (lambda |
| 3012 (x) |
| 3013 (format #t " possibilities for ~a:\n ~a\n" (car x) (cdr x))) |
| 3014 (cdar key-list)) |
| 3015 (key-list-loop (cdr key-list))))) |
| 3016 (key-list-loop key-list))) |
| 3017 |
| 3018 (define-markup-command |
| 3019 (woodwind-diagram layout props instrument input-list) |
| 3020 (symbol? list?) |
| 3021 #:category instrument-specific-markup ; markup category |
| 3022 "Make a woodwind-instrument diagram. For example, say |
| 3023 |
| 3024 @example |
| 3025 \\markup \\woodwind-diagram #'oboe #'(1.4 0.1 #t ((lh . (d ees)) (cc . (five3qT1
q)) (rh . (gis)))) |
| 3026 @end example |
| 3027 |
| 3028 @noindent |
| 3029 for an oboe with the left-hand d key, left-hand ees key, |
| 3030 and right-hand gis key depressed while the five-hole of |
| 3031 the central column effectuates a trill between 1/4 and 3/4 closed. |
| 3032 |
| 3033 The following instruments are supported: |
| 3034 @itemize @minus |
| 3035 |
| 3036 @item |
| 3037 piccolo |
| 3038 |
| 3039 @item |
| 3040 flute |
| 3041 |
| 3042 @item |
| 3043 oboe |
| 3044 |
| 3045 @item |
| 3046 clarinet |
| 3047 |
| 3048 @item |
| 3049 bass-clarinet |
| 3050 |
| 3051 @item |
| 3052 saxophone |
| 3053 |
| 3054 @item |
| 3055 bassoon |
| 3056 |
| 3057 @item |
| 3058 contrabassoon |
| 3059 |
| 3060 @end itemize |
| 3061 |
| 3062 To see all of the callable keys for a given instrument, |
| 3063 include the function @code{(print-keys 'instrument)} |
| 3064 in your .ly file, where instrument is the instrument |
| 3065 whose keys you want to print. |
| 3066 |
| 3067 Certain keys allow for special configurations. The entire gamut of |
| 3068 configurations possible is as follows: |
| 3069 |
| 3070 @itemize @minus |
| 3071 |
| 3072 @item |
| 3073 1q (1/4 covered) |
| 3074 |
| 3075 @item |
| 3076 1h (1/2 covered) |
| 3077 |
| 3078 @item |
| 3079 3q (3/4 covered) |
| 3080 |
| 3081 @item |
| 3082 R (ring depressed) |
| 3083 |
| 3084 @item |
| 3085 F (fully covered; the default if no state put) |
| 3086 |
| 3087 @end itemize |
| 3088 |
| 3089 Additionally, these configurations can be used in trills. So, for example, |
| 3090 @code{three3qTR} effectuates a trill between 3/4 full and ring depressed |
| 3091 on the three hole. As another example, @code{threeRT} effectuates a trill |
| 3092 between R and open, whereas @code{threeTR} effectuates a trill between open |
| 3093 and shut. To see all of the possibilities for all of the keys of a given |
| 3094 instrument, invoke @code{(print-keys-verbose 'instrument)}. |
| 3095 |
| 3096 Lastly, substituting an empty list for the pressed-key alist will result in |
| 3097 a diagram with all of the keys drawn but none filled. ie... |
| 3098 |
| 3099 @example |
| 3100 \\markup \\woodwind-diagram #'oboe #'(1.4 0.1 #t ()) |
| 3101 @end example" |
| 3102 (let* ((radius (car input-list)) |
| 3103 (thick (cadr input-list)) |
| 3104 (display-graphic (caddr input-list)) |
| 3105 (xy-stretch `(1.0 . 2.5)) |
| 3106 (chosen-instrument (assoc-get instrument woodwind-data-alist)) |
| 3107 (chosen-instrument |
| 3108 (if (not chosen-instrument) |
| 3109 (ly:error "~a is not a valid woodwind instrument." |
| 3110 instrument) |
| 3111 chosen-instrument)) |
| 3112 (stencil-info |
| 3113 (assoc-get |
| 3114 (if display-graphic 'graphical-commands 'text-commands) |
| 3115 chosen-instrument)) |
| 3116 (user-draw-commands (cadddr input-list)) |
| 3117 (pressed-info |
| 3118 (if (null? user-draw-commands) |
| 3119 (uniform-draw-instructions (assoc-get 'keys chosen-instrument)) |
| 3120 (translate-draw-instructions |
| 3121 (append '((hd . ())) user-draw-commands) |
| 3122 (assoc-get 'keys chosen-instrument)))) |
| 3123 (draw-info |
| 3124 (function-chain |
| 3125 pressed-info |
| 3126 (assoc-get 'draw-instructions stencil-info))) |
| 3127 (extra-offset-info |
| 3128 (function-chain |
| 3129 pressed-info |
| 3130 (assoc-get 'extra-offset-instructions stencil-info)))) |
| 3131 (assemble-stencils |
| 3132 (assoc-get 'stencil-alist stencil-info) |
| 3133 (assoc-get 'keys chosen-instrument) |
| 3134 draw-info |
| 3135 extra-offset-info |
| 3136 radius |
| 3137 thick |
| 3138 xy-stretch |
| 3139 layout |
| 3140 props))) |
OLD | NEW |