;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; ;;;; Copyright (C) 2010--2011 Mike Solomon ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by ;;;; the Free Software Foundation, either version 3 of the License, or ;;;; (at your option) any later version. ;;;; ;;;; LilyPond is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;;; GNU General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU General Public License ;;;; along with LilyPond. If not, see . ;; Constants (define CENTRAL-COLUMN-HOLE-PLACEMENTS '((one . (0.0 . 6.5)) (two . (0.0 . 5.5)) (three . (0.0 . 4.5)) (four . (0.0 . 3.0)) (five . (0.0 . 2.0)) (six . (0.0 . 1.0)))) (define CENTRAL-COLUMN-HOLE-LIST (map car CENTRAL-COLUMN-HOLE-PLACEMENTS)) (define CENTRAL-COLUMN-HOLE-H-LIST (cons 'h CENTRAL-COLUMN-HOLE-LIST)) ;; Utility functions (define (return-1 x) 1.0) (define (make-spreadsheet parameter-list) "Makes a spreadsheet function with columns of parameter-list. This function can then be filled with rows. For example: @code{guile> ((make-spreadsheet '(foo bar)) '((1 2) (3 4) (5 6)))} @code{(((foo . 1) (bar . 2)) ((foo . 3) (bar . 4)) ((foo . 5) (bar . 6)))}" (lambda (ls) (map (lambda (list-to-translate) (map (lambda (name element) `(,name . ,element)) parameter-list list-to-translate)) ls))) (define (get-spreadsheet-column column spreadsheet) "Gets all the values in @code{column} form @code{spreadsheet} made by @{make-spreadsheet}. For example: @code{guile> (get-spreadsheet-column 'bar ((make-spreadsheet '(foo bar)) '((1 2) (3 4) (5 6))))} @code{(2 4 6)}" (map (lambda (row) (assoc-get column row)) spreadsheet)) (define (make-named-spreadsheet parameter-list) "Makes a named spreadsheet function with columns of parameter-list. This function can then be filled with named rows For example: @code{guile> ((make-named-spreadsheet '(foo bar)) '((x . (1 2)) (y . (3 4)) (z . (5 6))))} @code{((x (foo . 1) (bar . 2)) (y (foo . 3) (bar . 4)) (z (foo . 5) (bar . 6)))}" (lambda (ls) (map (lambda (list-to-translate) `(,(list-ref list-to-translate 0) . ,(map (lambda (name element) `(,name . ,element)) parameter-list (list-tail list-to-translate 1)))) ls))) (define (get-named-spreadsheet-column column spreadsheet) "Gets all the values in @code{column} form @code{spreadsheet} made by @{make-named-spreadsheet}. For example: @code{guile> (get-spreadsheet-column 'bar ((make-named-spreadsheet '(foo bar)) '((x . (1 2)) (y . (3 4)) (z . (5 6)))))} @code{((x . 2) (y . 4) (z . 6))}" (map (lambda (row) (cons (car row) (assoc-get column (cdr row)))) spreadsheet)) (define make-key-alist (make-named-spreadsheet '(name offset graphical textual))) (define (simple-stencil-alist stencil offset) "A stencil alist that contains one and only one stencil. Shorthand used repeatedly in various instruments." `((stencils . (,stencil)) (offset . ,offset) (textual? . #f) (xy-scale-function . (,return-1 . ,return-1)))) (define (make-central-column-hole-addresses keys) "Takes @code{keys} and ascribes them to the central column." (map (lambda (key) `(central-column . ,key)) keys)) (define (make-key-symbols hand) "Takes @code{hand} and ascribes @code{key} to it." (lambda (keys) (map (lambda (key) `(,hand . ,key)) keys))) (define make-left-hand-key-addresses (make-key-symbols 'left-hand)) (define make-right-hand-key-addresses (make-key-symbols 'right-hand)) ;; Flute assembly instructions (define flute-change-points ((make-named-spreadsheet '(piccolo flute flute-b-extension)) `((bottom-group-key-names . (((x . ((offset . (-0.45 . -1.05)) (stencil . ,piccolo-rh-x-key-stencil) (text? . ("X" . #f)) (complexity . trill)))) ((cis . ((offset . (0.0 . 0.0)) (stencil . ,flute-rh-cis-key-stencil) (text? . ("C" . 1)) (complexity . trill))) (c . ((offset . (0.3 . 0.0)) (stencil . ,flute-rh-c-key-stencil) (text? . ("C" . #f)) (complexity . trill))) (gz . ((offset . (0.0 . -1.2)) (stencil . ,flute-rh-gz-key-stencil) (text? . ("gz" . #f)) (complexity . trill)))) ((cis . ((offset . (0.0 . 0.0)) (stencil . ,flute-rh-cis-key-stencil) (text? . ("C" . 1)) (complexity . trill))) (c . ((offset . (0.3 . 0.0)) (stencil . ,flute-rh-c-key-stencil) (text? . ("C" . #f)) (complexity . trill))) (b . ((offset . (1.0 . 0.0)) (stencil . ,flute-rh-b-key-stencil) (text? . ("B" . #f)) (complexity . trill))) (gz . ((offset . (0.0 . -1.2)) (stencil . ,flute-rh-gz-key-stencil) (text? . ("gz" . #f)) (complexity . trill)))))) (bottom-group-graphical-stencil . (((right-hand . ees) (right-hand . x)) ,(make-right-hand-key-addresses '(ees cis c gz)) ,(make-right-hand-key-addresses '(ees cis c b gz)))) (bottom-group-graphical-draw-instruction . (((right-hand . ees)) ,(make-right-hand-key-addresses '(ees cis c)) ,(make-right-hand-key-addresses '(ees cis c b)))) (bottom-group-special-key-instruction . ((,rich-group-draw-rule ((right-hand . x)) ((right-hand . ees))) (,rich-group-draw-rule ((right-hand . gz)) ,(make-right-hand-key-addresses '(ees cis c))) (,rich-group-draw-rule ((right-hand . gz)) ,(make-right-hand-key-addresses '(ees cis c b))))) (bottom-group-text-stencil . (,(make-right-hand-key-addresses '(bes d dis ees x)) ,(make-right-hand-key-addresses '(bes d dis ees cis c gz)) ,(make-right-hand-key-addresses '(bes d dis ees cis c b gz))))))) (define (generate-flute-family-entry flute-name) (let* ((change-points (get-named-spreadsheet-column flute-name flute-change-points))) `(,flute-name . ((keys . ((hidden . ((midline . ((offset . (0.0 . 0.0)) (stencil . ,midline-stencil) (text? . #f) (complexity . basic))))) (central-column . ((one . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (two . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (three . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (four . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (five . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (six . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))))) (left-hand . ((bes . ((offset . (0.5 . 1.8)) (stencil . ,flute-lh-bes-key-stencil) (text? . ("B" . 0)) (complexity . trill))) (b . ((offset . (0.0 . 0.0)) (stencil . ,flute-lh-b-key-stencil) (text? . ("B" . #f)) (complexity . trill))) (gis . ((offset . (0.0 . 0.0)) (stencil . ,flute-lh-gis-key-stencil) (text? . ("G" . 1)) (complexity . trill))))) (right-hand . ,(append `((bes . ((offset . (0.0 . 0.0)) (stencil . ,flute-rh-bes-key-stencil) (text? . ("B" . 0)) (complexity . trill))) (d . ((offset . (0.0 . 0.0)) (stencil . ,flute-rh-d-key-stencil) (text? . ("D" . #f)) (complexity . trill))) (dis . ((offset . (0.0 . 0.0)) (stencil . ,flute-rh-dis-key-stencil) (text? . ("D" . 1)) (complexity . trill))) (ees . ((offset . (1.5 . 1.3)) (stencil . ,flute-rh-ees-key-stencil) (text? . ("E" . 0)) (complexity . trill)))) (assoc-get 'bottom-group-key-names change-points))))) (graphical-commands . ((stencil-alist . ((stencils . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) ((stencils . ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0))) ((stencils . ((left-hand . bes) (left-hand . b))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-1.5 . 6.5))) ,(simple-stencil-alist '(left-hand . gis) '(1.0 . 4.0)) ,(simple-stencil-alist '(right-hand . bes) '(-1.75 . 3.05)) ,(simple-stencil-alist '(right-hand . d) '(-1.0 . 2.5)) ,(simple-stencil-alist '(right-hand . dis) '(-1.0 . 1.5)) ((stencils . ,(assoc-get 'bottom-group-graphical-stencil change-points)) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (0.0 . -0.6))))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0)))) (draw-instructions . ((,apply-group-draw-rule-series (((left-hand . bes) (left-hand . b)) ,(assoc-get 'bottom-group-graphical-draw-instruction change-points))) ,(assoc-get 'bottom-group-special-key-instruction change-points) (,group-automate-rule ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (,group-automate-rule ((hidden . midline))))) (extra-offset-instructions . ((,uniform-extra-offset-rule (0.0 . 0.0)))))) (text-commands . ((stencil-alist . ((stencils . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) ((stencils . ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0))) ((stencils . ,(make-left-hand-key-addresses '(bes b gis))) (textual? . ,lh-woodwind-text-stencil) (offset . (1.5 . 3.75))) ((stencils . ,(assoc-get 'bottom-group-text-stencil change-points)) (textual? . ,rh-woodwind-text-stencil) (offset . (-1.25 . 0.0))))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0)))) (draw-instructions . ((,apply-group-draw-rule-series (,(make-left-hand-key-addresses '(bes b gis)) ,(assoc-get 'bottom-group-text-stencil change-points))) (,group-automate-rule ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (,group-automate-rule ((hidden . midline))))) (extra-offset-instructions . ((,uniform-extra-offset-rule (0.0 . 0.0)))))))))) ;;; Tin whistle assembly instructions (define tin-whistle-change-points ((make-named-spreadsheet '(tin-whistle)) '())) (define (generate-tin-whistle-family-entry tin-whistle-name) (let* ((change-points (get-named-spreadsheet-column tin-whistle-name tin-whistle-change-points))) `(,tin-whistle-name . ((keys . ((hidden . ((midline . ((offset . (0.0 . 0.0)) (stencil . ,midline-stencil) (text? . #f) (complexity . basic))))) (central-column . ((one . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . covered))) (two . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . covered))) (three . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . covered))) (four . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . covered))) (five . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . covered))) (six . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . covered))))) (left-hand . ()) (right-hand . ()))) (graphical-commands . ((stencil-alist . ((stencils . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) ((stencils . ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0))))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0)))) (draw-instructions . ((,group-automate-rule ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (,group-automate-rule ((hidden . midline))))) (extra-offset-instructions . ((,uniform-extra-offset-rule (0.0 . 0.0)))))) (text-commands . ((stencil-alist . ((stencils . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) ((stencils . ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-H-LIST)) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0))))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0)))) (draw-instructions . ((,group-automate-rule ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (,group-automate-rule ((hidden . midline))))) (extra-offset-instructions . ((,uniform-extra-offset-rule (0.0 . 0.0)))))))))) ;;; Oboe assembly instructions (define oboe-change-points ((make-named-spreadsheet '(oboe)) '())) (define (generate-oboe-family-entry oboe-name) (let* ((change-points (get-named-spreadsheet-column oboe-name oboe-change-points))) `(,oboe-name . ((keys . ((hidden . ((midline . ((offset . (0.0 . 0.0)) (stencil . ,midline-stencil) (text? . #f) (complexity . basic))))) (central-column . ((one . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (two . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (three . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (four . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (five . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (six . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (h . ((offset . (0.0 . 6.25)) (stencil . ,(variable-column-circle-stencil 0.4)) (text? . #f) (complexity . trill))))) (left-hand . ((I . ((offset . (0.0 . 0.0)) (stencil . ,oboe-lh-I-key-stencil) (text? . ("I" . #f)) (complexity . trill))) (III . ((offset . (0.0 . 2.6)) (stencil . ,oboe-lh-III-key-stencil) (text? . ("III" . #f)) (complexity . trill))) (II . ((offset . (0.0 . 0.0)) (stencil . ,oboe-lh-II-key-stencil) (text? . ("II" . #f)) (complexity . trill))) (b . ((offset . (0.0 . 0.0)) (stencil . ,oboe-lh-b-key-stencil) (text? . ("B" . #f)) (complexity . trill))) (d . ((offset . (0.0 . 0.0)) (stencil . ,oboe-lh-d-key-stencil) (text? . ("D" . #f)) (complexity . trill))) (cis . ((offset . (0.0 . 0.0)) (stencil . ,oboe-lh-cis-key-stencil) (text? . ("C" . 1)) (complexity . trill))) (gis . ((offset . (-0.85 . 0.2)) (stencil . ,oboe-lh-gis-key-stencil) (text? . ("G" . 1)) (complexity . trill))) (ees . ((offset . (2.05 . -3.65)) (stencil . ,oboe-lh-ees-key-stencil) (text? . ("E" . 0)) (complexity . trill))) (low-b . ((offset . (3.6 . 0.5)) (stencil . ,oboe-lh-low-b-key-stencil) (text? . ("b" . #f)) (complexity . trill))) (bes . ((offset . (2.25 . -4.15)) (stencil . ,oboe-lh-bes-key-stencil) (text? . ("B" . 0)) (complexity . trill))) (f . ((offset . (2.15 . -3.85)) (stencil . ,oboe-lh-f-key-stencil) (text? . ("F" . #f)) (complexity . trill))))) (right-hand . ((a . ((offset . (1.5 . 1.2)) (stencil . ,oboe-rh-a-key-stencil) (text? . ("A" . #f)) (complexity . trill))) (gis . ((offset . (0.0 . 0.0)) (stencil . ,oboe-rh-gis-key-stencil) (text? . ("G" . 1)) (complexity . trill))) (d . ((offset . (0.0 . 0.0)) (stencil . ,oboe-rh-d-key-stencil) (text? . ("D" . #f)) (complexity . trill))) (f . ((offset . (0.0 . 0.0)) (stencil . ,oboe-rh-f-key-stencil) (text? . ("F" . #f)) (complexity . trill))) (banana . ((offset . (0.0 . 0.0)) (stencil . ,oboe-rh-banana-key-stencil) (text? . ("ban" . #f)) (complexity . trill))) (c . ((offset . (0.0 . 0.0)) (stencil . ,oboe-rh-c-key-stencil) (text? . ("C" . #f)) (complexity . trill))) (cis . ((offset . (3.8 . -0.6)) (stencil . ,oboe-rh-cis-key-stencil) (text? . ("C" . 1)) (complexity . trill))) (ees . ((offset . (0.0 . -1.8)) (stencil . ,oboe-rh-ees-key-stencil) (text? . ("E" . 0)) (complexity . trill))))))) (graphical-commands . ((stencil-alist . ((stencils . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) ((stencils . ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-H-LIST)) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0))) ((stencils . ((left-hand . I) (left-hand . III))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-2.5 . 6.5))) ,(simple-stencil-alist '(left-hand . II) '(2.5 . 6.0)) ,(simple-stencil-alist '(left-hand . b) '(-1.35 . 6.0)) ,(simple-stencil-alist '(left-hand . d) '(1.0 . 6.0)) ,(simple-stencil-alist '(left-hand . cis) '(1.0 . 5.0)) ((stencils . ,(make-left-hand-key-addresses '(gis bes low-b ees f))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (0.0 . 3.9))) ((stencils . ,(make-right-hand-key-addresses '(a gis))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-3.5 . 3.5))) ,(simple-stencil-alist '(right-hand . d) '(1.0 . 2.5)) ,(simple-stencil-alist '(right-hand . f) '(-1.0 . 1.5)) ,(simple-stencil-alist '(right-hand . banana) '(1.7 . 1.0)) ((stencils . ,(make-right-hand-key-addresses '(c cis ees))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-3.4 . 0.3))))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0)))) (draw-instructions . ((,apply-group-draw-rule-series (((right-hand . a) (right-hand . gis)) ,(make-left-hand-key-addresses '(gis bes low-b ees)) ,(make-right-hand-key-addresses '(cis c ees)))) (,rich-group-draw-rule ((left-hand . III)) ((left-hand . I))) (,rich-group-draw-rule ((left-hand . f)) ,(make-left-hand-key-addresses '(gis bes low-b ees))) (,group-automate-rule ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (,group-automate-rule ((hidden . midline))))) (extra-offset-instructions . ((,rich-group-extra-offset-rule ((central-column . h)) ((central-column . one)) (0.0 . 0.8)) (,uniform-extra-offset-rule (0.0 . 0.0)))))) (text-commands . ((stencil-alist . ((stencils . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) ((stencils . ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-H-LIST)) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0))) ((stencils . ,(make-left-hand-key-addresses '(III I))) (textual? . ,lh-woodwind-text-stencil) (offset . (-2.8 . 7.0))) ((stencils . ,(make-left-hand-key-addresses '(II))) (textual? . ,lh-woodwind-text-stencil) (offset . (2.2 . 7.0))) ((stencils . ,(make-left-hand-key-addresses '(b d cis gis ees low-b bes f))) (textual? . ,lh-woodwind-text-stencil) (offset . (1.5 . 3.75))) ((stencils . ,(make-right-hand-key-addresses '(a gis d f banana c cis ees))) (textual? . ,rh-woodwind-text-stencil) (offset . (-1.25 . 0.0))))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0)))) (draw-instructions . ((,apply-group-draw-rule-series (,(make-left-hand-key-addresses '(b d cis gis ees low-b bes f)) ,(make-left-hand-key-addresses '(III I)) ,(make-right-hand-key-addresses '(a gis d f banana c cis ees)))) (,group-automate-rule ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (,group-automate-rule ((hidden . midline))))) (extra-offset-instructions . ((,rich-group-extra-offset-rule ((central-column . h)) ((central-column . one)) (0.0 . 0.8)) (,uniform-extra-offset-rule (0.0 . 0.0)))))))))) ;; Clarinet assembly instructions (define clarinet-change-points ((make-named-spreadsheet '(clarinet bass-clarinet low-bass-clarinet)) `((bottom-group-key-names . (() ((low-es . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR)))) (stencil . ,bass-clarinet-rh-low-es-key-stencil) (text? . ("E" . #f)) (complexity . trill)))) ((low-es . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR)))) (stencil . ,low-bass-clarinet-rh-low-es-key-stencil) (text? . ("E" . #f)) (complexity . trill))) (low-d . ((offset . (,(+ 1.5 CL-RH-HAIR) . ,(* -1 (+ 0.75 CL-RH-HAIR)))) (stencil . ,clarinet-rh-low-d-key-stencil) (text? . ("d" . #f)) (complexity . trill))) (low-cis . ((offset . (0.0 . 1.4)) (stencil . ,clarinet-rh-low-cis-key-stencil) (text? . ("c" . 1)) (complexity . trill))) (low-d . ((offset . (0.0 . 2.4)) (stencil . ,clarinet-rh-low-d-key-stencil) (text? . ("d" . #f)) (complexity . trill))) (low-c . ((offset . (0.0 . 0.0)) (stencil . ,clarinet-rh-low-c-key-stencil) (text? . ("c" . #f)) (complexity . trill)))))) (left-extra-key-names . (() () ((low-d . ((offset . (4.0 . -0.8)) (stencil . ,clarinet-lh-low-d-key-stencil) (text? . ("D" . #f)) (complexity . trill)))))) (right-thumb-group . (() () (((stencils . ,(make-right-hand-key-addresses '(low-c low-cis))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-1.3 . 4.0)))))) (low-left-hand-key-addresses . (,(make-left-hand-key-addresses '(cis f e fis)) ,(make-left-hand-key-addresses '(cis f e fis)) ,(make-left-hand-key-addresses '(cis f e fis low-d)))) (all-left-hand-key-addresses . (,(make-left-hand-key-addresses '(a gis cis f m-es e fis)) ,(make-left-hand-key-addresses '(a gis cis f m-es e fis)) ,(make-left-hand-key-addresses '(a gis cis f m-es e fis low-d)))) (low-key-group . (() () (,(make-right-hand-key-addresses '(low-c low-cis))))) (low-rich-draw-rules . (() () ((,rich-group-draw-rule ((left-hand . low-d)) ,(make-left-hand-key-addresses '(cis f m-es e fis))) (,rich-group-draw-rule ((right-hand . low-d)) ((right-hand . low-cis) (right-hand . low-c)))))) (low-extra-offset-rule . (() () ((,rich-group-extra-offset-rule ,(make-right-hand-key-addresses '(low-c low-d low-cis)) ,(make-right-hand-key-addresses '(one two three four)) (-0.5 . -0.7))))) (bottom-right-group-key-addresses . (,(make-right-hand-key-addresses '(fis gis e f)) ,(make-right-hand-key-addresses '(fis gis e f low-es)) ,(make-right-hand-key-addresses '(fis gis e f low-es low-d)))) (right-hand-key-addresses . (,(make-right-hand-key-addresses '(fis gis e f)) ,(make-right-hand-key-addresses '(fis gis e f low-es)) ,(make-right-hand-key-addresses '(low-d low-cis low-c fis gis e f low-es low-d))))))) (define (generate-clarinet-family-entry clarinet-name) (let* ((change-points (get-named-spreadsheet-column clarinet-name clarinet-change-points))) `(,clarinet-name . ((keys . ((hidden . ((midline . ((offset . (0.0 . 0.0)) (stencil . ,midline-stencil) (text? . #f) (complexity . basic))))) (central-column . ((one . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . covered))) (two . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . covered))) (three . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . covered))) (four . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . covered))) (five . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . covered))) (six . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . covered))) (h . ((offset . (0.0 . 6.25)) (stencil . ,(variable-column-circle-stencil 0.4)) (text? . #f) (complexity . covered))))) (left-hand . ,(append `((thumb . ((offset . (0.0 . 0.0)) (stencil . ,clarinet-lh-thumb-key-stencil) (text? . #f) (complexity . trill))) (R . ((offset . (1.0 . 1.0)) (stencil . ,clarinet-lh-R-key-stencil) (text? . #f) (complexity . trill))) (a . ((offset . (0.0 . 0.0)) (stencil . ,clarinet-lh-a-key-stencil) (text? . ("A" . #f)) (complexity . trill))) (gis . ((offset . (0.8 . 1.0)) (stencil . ,clarinet-lh-gis-key-stencil) (text? . ("G" . 1)) (complexity . trill))) (m-es . ((offset . (0.0 . 0.0)) (stencil . ,clarinet-lh-e-key-stencil) (text? . ("E" . 0)) (complexity . trill))) (cis . ((offset . (-0.85 . 0.2)) (stencil . ,clarinet-lh-cis-key-stencil) (text? . ("C" . 1)) (complexity . trill))) (f . ((offset . (3.6 . 0.5)) (stencil . ,clarinet-lh-f-key-stencil) (text? . ("F" . #f)) (complexity . trill))) (e . ((offset . (2.05 . -3.65)) (stencil . ,clarinet-lh-ee-key-stencil) (text? . ("E" . #f)) (complexity . trill))) (fis . ((offset . (2.25 . -4.15)) (stencil . ,clarinet-lh-fis-key-stencil) (text? . ("F" . 1)) (complexity . trill)))) (assoc-get 'left-extra-key-names change-points))) (right-hand . ,(append `((one . ((offset . (0.0 . 0.75)) (stencil . ,clarinet-rh-one-key-stencil) (text? . "1") (complexity . trill))) (two . ((offset . (0.0 . 0.25)) (stencil . ,clarinet-rh-two-key-stencil) (text? . "2") (complexity . trill))) (three . ((offset . (0.0 . -0.25)) (stencil . ,clarinet-rh-three-key-stencil) (text? . "3") (complexity . trill))) (four . ((offset . (0.0 . -0.75)) (stencil . ,clarinet-rh-four-key-stencil) (text? . "4") (complexity . trill))) (b . ((offset . (0.0 . 0.0)) (stencil . ,clarinet-rh-b-key-stencil) (text? . ("B" . #f)) (complexity . trill))) (fis . ((offset . (0.0 . ,(* 4 (+ 0.75 CL-RH-HAIR)))) (stencil . ,clarinet-rh-fis-key-stencil) (text? . ("F" . 1)) (complexity . trill))) (gis . ((offset . (,(+ 1.5 CL-RH-HAIR) . ,(* 3 (+ 0.75 CL-RH-HAIR)))) (stencil . ,clarinet-rh-gis-key-stencil) (text? . ("G" . #f)) (complexity . trill))) (e . ((offset . (0.0 . ,(* 2 (+ 0.75 CL-RH-HAIR)))) (stencil . ,clarinet-rh-e-key-stencil) (text? . ("E" . 0)) (complexity . trill))) (f . ((offset . (,(+ 1.5 CL-RH-HAIR) . ,(* 1 (+ 0.75 CL-RH-HAIR)))) (stencil . ,clarinet-rh-f-key-stencil) (text? . ("F" . 0)) (complexity . trill)))) (assoc-get 'bottom-group-key-names change-points))))) (graphical-commands . ((stencil-alist . ((stencils . ,(append (assoc-get 'right-thumb-group change-points) `(,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) ((stencils . ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-H-LIST)) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0))) ((stencils . ,(make-left-hand-key-addresses '(thumb R))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (-2.5 . 6.5))) ((stencils . ((left-hand . a) (left-hand . gis))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (0.0 . 7.5))) ,(simple-stencil-alist '(left-hand . m-es) '(1.0 . 5.0)) ((stencils . ,(make-left-hand-key-addresses '(cis f e fis))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (0.0 . 3.9))) ((stencils . ,(make-right-hand-key-addresses '(one two three four))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-1.25 . 3.75))) ,(simple-stencil-alist '(right-hand . b) '(-1.0 . 1.5)) ((stencils . ,(assoc-get 'bottom-right-group-key-addresses change-points)) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-4.0 . -0.75)))))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0)))) (draw-instructions . ,(append (assoc-get 'low-rich-draw-rules change-points) `((,apply-group-draw-rule-series ,(append (assoc-get 'low-key-group change-points) `(((left-hand . a) (left-hand . gis)) ,(make-right-hand-key-addresses '(one two three four)) ,(assoc-get 'low-left-hand-key-addresses change-points) ,(assoc-get 'right-hand-key-addresses change-points)))) (,rich-group-draw-rule ((left-hand . R)) ((left-hand . thumb))) (,group-automate-rule ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (,group-automate-rule ((hidden . midline)))))) (extra-offset-instructions . ,(append (assoc-get 'low-extra-offset-rule change-points) `((,rich-group-extra-offset-rule ((central-column . h)) ((central-column . one) (left-hand . a) (left-hand . gis)) (0.0 . 0.8)) (,uniform-extra-offset-rule (0.0 . 0.0))))))) (text-commands . ((stencil-alist . ((stencils . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) ((stencils . ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0))) ((stencils . ((left-hand . thumb) (left-hand . R))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (-2.5 . 6.5))) ((stencils . ,(assoc-get 'all-left-hand-key-addresses change-points)) (textual? . ,lh-woodwind-text-stencil) (offset . (1.5 . 3.75))) ((stencils . ,(make-right-hand-key-addresses '(one two three four))) (textual? . ,number-column-stencil) (offset . (-1.25 . 3.75))) ((stencils . ,(assoc-get 'right-hand-key-addresses change-points)) (textual? . ,rh-woodwind-text-stencil) (offset . (-1.25 . 0.0))))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0)))) (draw-instructions . ((,apply-group-draw-rule-series (,(assoc-get 'all-left-hand-key-addresses change-points) ,(make-right-hand-key-addresses '(one two three four)) ,(assoc-get 'right-hand-key-addresses change-points))) (,group-automate-rule ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (,group-automate-rule ((hidden . midline))))) (extra-offset-instructions . ((,rich-group-extra-offset-rule ((central-column . h)) ((central-column . one) (left-hand . a) (left-hand . gis)) (0.0 . 0.8)) (,uniform-extra-offset-rule (0.0 . 0.0)))))))))) ;; Saxophone assembly instructions (define (saxophone-name-passerelle name) (cond ((eqv? name 'saxophone) 'saxophone) ((eqv? name 'soprano-saxophone) 'saxophone) ((eqv? name 'alto-saxophone) 'saxophone) ((eqv? name 'tenor-saxophone) 'saxophone) ((eqv? name 'baritone-saxophone) 'baritone-saxophone))) (define saxophone-change-points ((make-named-spreadsheet '(saxophone baritone-saxophone)) `((low-a-key-definition . (() ((low-a . ((offset . (0.0 . 0.0)) (stencil . ,saxophone-lh-low-a-key-stencil) (text? . #f) (complexity . trill)))))) (low-a-key-group . (() (,(simple-stencil-alist '(left-hand . low-a) '(-5.0 . 7.0))))) (low-a-presence . (() ((left-hand . low-a)))) (left-hand-key-names . (,(make-right-hand-key-addresses '(ees d f front-f bes gis cis b low-bes)) ,(make-right-hand-key-addresses '(ees d f front-f bes gis cis b low-bes low-a))))))) (define (generate-saxophone-family-entry saxophone-name) (let* ((change-points (get-named-spreadsheet-column (saxophone-name-passerelle saxophone-name) saxophone-change-points))) `(,saxophone-name . ((keys . ((hidden . ((midline . ((offset . (0.0 . 0.0)) (stencil . ,midline-stencil) (text? . #f) (complexity . basic))))) (central-column . ((one . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . trill))) (two . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . trill))) (three . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . trill))) (four . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . trill))) (five . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . trill))) (six . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,column-circle-stencil) (text? . #f) (complexity . trill))))) (left-hand . ,(append (assoc-get 'low-a-key-definition change-points) `((T . ((offset . (0.0 . 0.0)) (stencil . ,saxophone-lh-T-key-stencil) (text? . ("T" . #f)) (complexity . trill))) (ees . ((offset . (0.4 . 1.6)) (stencil . ,saxophone-lh-ees-key-stencil) (text? . ("E" . 0)) (complexity . trill))) (d . ((offset . (1.5 . 0.5)) (stencil . ,saxophone-lh-d-key-stencil) (text? . ("D" . #f)) (complexity . trill))) (f . ((offset . (0.0 . 0.0)) (stencil . ,saxophone-lh-f-key-stencil) (text? . ("F" . #f)) (complexity . trill))) (front-f . ((offset . (0.0 . 0.0)) (stencil . ,saxophone-lh-front-f-key-stencil) (text? . ("f" . #f)) (complexity . trill))) (bes . ((offset . (0.0 . 0.0)) (stencil . ,saxophone-lh-bes-key-stencil) (text? . ("B" . 0)) (complexity . trill))) (gis . ((offset . (0.0 . 1.1)) (stencil . ,saxophone-lh-gis-key-stencil) (text? . ("G" . 1)) (complexity . trill))) (cis . ((offset . (2.4 . 0.0)) (stencil . ,saxophone-lh-cis-key-stencil) (text? . ("C" . 1)) (complexity . trill))) (b . ((offset . (0.0 . 0.0)) (stencil . ,saxophone-lh-b-key-stencil) (text? . ("B" . #f)) (complexity . trill))) (low-bes . ((offset . (0.0 . -0.2)) (stencil . ,saxophone-lh-low-bes-key-stencil) (text? . ("b" . 0)) (complexity . trill)))))) (right-hand . ((e . ((offset . (0.0 . 2.0)) (stencil . ,saxophone-rh-e-key-stencil) (text? . ("E" . #f)) (complexity . trill))) (c . ((offset . (0.0 . 0.9)) (stencil . ,saxophone-rh-c-key-stencil) (text? . ("C" . #f)) (complexity . trill))) (bes . ((offset . (0.0 . 0.0)) (stencil . ,saxophone-rh-bes-key-stencil) (text? . ("B" . 0)) (complexity . trill))) (high-fis . ((offset . (0.0 . 0.0)) (stencil . ,saxophone-rh-high-fis-key-stencil) (text? . ("hF" . 1)) (complexity . trill))) (fis . ((offset . (0.0 . 0.0)) (stencil . ,saxophone-rh-fis-key-stencil) (text? . ("F" . 1)) (complexity . trill))) (ees . ((offset . (0.0 . 0.7)) (stencil . ,saxophone-rh-ees-key-stencil) (text? . ("E" . 0)) (complexity . trill))) (low-c . ((offset . (-1.2 . -0.1)) (stencil . ,saxophone-rh-low-c-key-stencil) (text? . ("c" . #f)) (complexity . trill))))))) (graphical-commands . ((stencil-alist . ((stencils . ,(append (assoc-get 'low-a-key-group change-points) `(,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) ((stencils . ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0))) ((stencils . ,(make-left-hand-key-addresses '(ees d f))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (1.5 . 6.8))) ,(simple-stencil-alist '(left-hand . front-f) '(0.0 . 7.35)) ,(simple-stencil-alist '(left-hand . T) '(-2.2 . 6.5)) ,(simple-stencil-alist '(left-hand . bes) '(0.0 . 6.2)) ((stencils . ,(make-left-hand-key-addresses '(gis cis b low-bes))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (1.2 . 3.5))) ((stencils . ,(make-right-hand-key-addresses '(e c bes))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-2.3 . 3.4))) ,(simple-stencil-alist '(right-hand . high-fis) '(-1.8 . 2.5)) ,(simple-stencil-alist '(right-hand . fis) '(-1.5 . 1.5)) ((stencils . ,(make-right-hand-key-addresses '(ees low-c))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-2.0 . 0.3)))))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0)))) (draw-instructions . ((,apply-group-draw-rule-series (,(make-left-hand-key-addresses '(ees d f)) ,(make-left-hand-key-addresses '(gis cis b low-bes)) ,(make-right-hand-key-addresses '(e c bes)) ,(make-right-hand-key-addresses '(ees low-c)))) (,group-automate-rule ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (,group-automate-rule ((hidden . midline))))) (extra-offset-instructions . ((,rich-group-extra-offset-rule ((left-hand . bes)) ,(append (assoc-get 'low-a-presence change-points) '((central-column . one) (left-hand . front-f) (left-hand . T) (left-hand . ees) (left-hand . d) (left-hand . f))) (0.0 . 1.0)) (,uniform-extra-offset-rule (0.0 . 0.0)))))) (text-commands . ((stencil-alist . ((stencils . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) ((stencils . ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0))) ,(simple-stencil-alist '(left-hand . T) '(-1.0 . 7.0)) ((stencils . ,(assoc-get 'left-hand-key-names change-points)) (textual? . ,lh-woodwind-text-stencil) (offset . (1.5 . 3.75))) ((stencils . ,(make-right-hand-key-addresses '(e c bes high-fis fis ees low-c))) (textual? . ,rh-woodwind-text-stencil) (offset . (-1.25 . 0.0))))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0)))) (draw-instructions . ((,apply-group-draw-rule-series (,(make-left-hand-key-addresses '(ees d f front-f bes gis cis b low-bes)) ,(make-right-hand-key-addresses '(e c bes high-fis fis ees low-c)))) (,group-automate-rule ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (,group-automate-rule ((hidden . midline))))) (extra-offset-instructions . ((,uniform-extra-offset-rule (0.0 . 0.0)))))))))) ;; Bassoon assembly instructions (define bassoon-change-points ((make-named-spreadsheet '(bassoon contrabassoon)) `((left-hand-additional-keys . (((a . ((offset . (0.0 . -0.3)) (stencil . ,bassoon-lh-a-flick-key-stencil) (text? . ("A" . #f)) (complexity . trill))) (w . ((offset . (0.0 . 0.0)) (stencil . ,bassoon-lh-whisper-key-stencil) (text? . ("w" . #f)) (complexity . trill)))) ())) (right-hand-additional-keys . (((cis . ((offset . (0.0 . 0.0)) (stencil . ,bassoon-rh-cis-key-stencil) (text? . ("C" . 1)) (complexity . trill))) (thumb-gis . ((offset . (0.0 . 0.0)) (stencil . ,bassoon-rh-thumb-gis-key-stencil) (text? . ("G" . 1)) (complexity . trill)))) ())) (left-hand-flick-group . (((left-hand . d) (left-hand . c) (left-hand . a)) ((left-hand . d) (left-hand . c)))) (left-hand-thumb-group . (((left-hand . w) (left-hand . thumb-cis)) ((left-hand . thumb-cis)))) (cis-offset-instruction . (((,rich-group-extra-offset-rule ((right-hand . cis)) ,(append '((hidden . midline) (hidden . long-midline)) (make-central-column-hole-addresses '(three two one)) (make-left-hand-key-addresses '(low-b low-bes low-c low-d d a c w thumb-cis high-ees high-e cis ees))) (0.0 . 0.9))) ())) (right-hand-lower-thumb-group . (((right-hand . thumb-gis) (right-hand . thumb-fis)) ((right-hand . thumb-fis)))) (right-hand-cis-key . ((,(simple-stencil-alist '(right-hand . cis) '(-2.3 . 3.22))) ())) (back-left-hand-key-addresses . ((low-b low-bes low-c low-d d a c w thumb-cis) (low-b low-bes low-c low-d d c thumb-cis))) (front-right-hand-key-addresses . ((cis bes fis f gis) (bes fis f gis))) (back-right-hand-key-addresses . ((thumb-bes thumb-gis thumb-e thumb-fis) (thumb-bes thumb-e thumb-fis)))))) (define (generate-bassoon-family-entry bassoon-name) (let* ((change-points (get-named-spreadsheet-column bassoon-name bassoon-change-points))) `(,bassoon-name . ((keys . ((hidden . ((midline . ((offset . (0.0 . 0.0)) (stencil . ,midline-stencil) (text? . #f) (complexity . basic))) (long-midline . ((offset . (0.0 . 0.0)) (stencil . ,long-midline-stencil) (text? . #f) (complexity . basic))))) (central-column . ((one . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,bassoon-cc-one-key-stencil) (text? . #f) (complexity . trill))) (two . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (three . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (four . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (five . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))) (six . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS)) (stencil . ,ring-column-circle-stencil) (text? . #f) (complexity . ring))))) (left-hand . ,(append (assoc-get 'left-hand-additional-keys change-points) `((high-e . ((offset . (0.0 . 0.0)) (stencil . ,bassoon-lh-he-key-stencil) (text? . ("hE" . #f)) (complexity . trill))) (high-ees . ((offset . (0.0 . 0.0)) (stencil . ,bassoon-lh-hees-key-stencil) (text? . ("hE" . 0)) (complexity . trill))) (ees . ((offset . (-1.0 . 1.0)) (stencil . ,bassoon-lh-ees-key-stencil) (text? . ("E" . 0)) (complexity . trill))) (cis . ((offset . (0.0 . 0.0)) (stencil . ,bassoon-lh-cis-key-stencil) (text? . ("C" . 1)) (complexity . trill))) (low-bes . ((offset . (0.0 . 0.0)) (stencil . ,bassoon-lh-lbes-key-stencil) (text? . ("b" . 0)) (complexity . trill))) (low-b . ((offset . (-1.0 . -0.7)) (stencil . ,bassoon-lh-lb-key-stencil) (text? . ("b" . #f)) (complexity . trill))) (low-c . ((offset . (0.0 . 0.0)) (stencil . ,bassoon-lh-lc-key-stencil) (text? . ("c" . #f)) (complexity . trill))) (low-d . ((offset . (0.0 . 0.0)) (stencil . ,bassoon-lh-ld-key-stencil) (text? . ("d" . #f)) (complexity . trill))) (d . ((offset . (-1.5 . 2.0)) (stencil . ,bassoon-lh-d-flick-key-stencil) (text? . ("D" . #f)) (complexity . trill))) (c . ((offset . (-0.8 . 1.1)) (stencil . ,bassoon-lh-c-flick-key-stencil) (text? . ("C" . #f)) (complexity . trill))) (thumb-cis . ((offset . (2.0 . -1.0)) (stencil . ,bassoon-lh-thumb-cis-key-stencil) (text? . ("C" . 1)) (complexity . trill)))))) (right-hand . ,(append (assoc-get 'right-hand-additional-keys change-points) `((bes . ((offset . (0.0 . 0.8)) (stencil . ,bassoon-rh-bes-key-stencil) (text? . ("B" . 0)) (complexity . trill))) (f . ((offset . (-2.2 . 4.35)) (stencil . ,bassoon-rh-f-key-stencil) (text? . ("F" . #f)) (complexity . trill))) (fis . ((offset . (1.5 . 1.0)) (stencil . ,bassoon-rh-fis-key-stencil) (text? . ("F" . 1)) (complexity . trill))) (gis . ((offset . (0.0 . -0.15)) (stencil . ,bassoon-rh-gis-key-stencil) (text? . ("G" . 1)) (complexity . trill))) (thumb-bes . ((offset . (0.0 . 0.0)) (stencil . ,bassoon-rh-thumb-bes-key-stencil) (text? . ("B" . 0)) (complexity . trill))) (thumb-e . ((offset . (1.75 . 0.4)) (stencil . ,bassoon-rh-thumb-e-key-stencil) (text? . ("E" . #f)) (complexity . trill))) (thumb-fis . ((offset . (-1.0 . 1.6)) (stencil . ,bassoon-rh-thumb-fis-key-stencil) (text? . ("F" . 1)) (complexity . trill)))))))) (graphical-commands . ((stencil-alist . ((stencils . ,(append (assoc-get 'right-hand-cis-key change-points) `(,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) ,(simple-stencil-alist '(hidden . long-midline) '(0.0 . 3.80)) ((stencils . ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0))) ,(simple-stencil-alist '(left-hand . high-e) '(-1.0 . 7.0)) ,(simple-stencil-alist '(left-hand . high-ees) '(-1.0 . 6.0)) ((stencils . ((left-hand . ees) (left-hand . cis))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (3.0 . 3.75))) ((stencils . (((stencils . ((left-hand . low-b) (left-hand . low-bes))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-2.0 . 9.0))) ((stencils . ,(assoc-get 'left-hand-flick-group change-points)) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (3.0 . 7.0))) ,(simple-stencil-alist '(left-hand . low-c) '(-1.0 . 4.5)) ,(simple-stencil-alist '(left-hand . low-d) '(-1.0 . 0.1)) ((stencils . ,(assoc-get 'left-hand-thumb-group change-points)) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (1.5 . -0.6))))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-5.5 . 4.7))) ,(simple-stencil-alist '(right-hand . bes) '(1.0 . 1.2)) ((stencils . ,(make-right-hand-key-addresses '(gis f fis))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (2.0 . -1.25))) ((stencils . (((stencils . ((right-hand . thumb-bes) (right-hand . thumb-e))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-1.22 . 5.25))) ((stencils . ,(assoc-get 'right-hand-lower-thumb-group change-points)) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (0.0 . 0.0))))) (xy-scale-function . (,return-1 . ,return-1)) (textual? . #f) (offset . (-5.0 . 0.0)))))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0)))) (draw-instructions . ((,apply-group-draw-rule-series (,(make-left-hand-key-addresses '(ees cis)) ,(make-left-hand-key-addresses (assoc-get 'back-left-hand-key-addresses change-points)) ,(make-right-hand-key-addresses '(f fis gis)) ,(make-right-hand-key-addresses (assoc-get 'back-right-hand-key-addresses change-points)))) (,group-automate-rule ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (,bassoon-midline-rule ,(append (make-left-hand-key-addresses (assoc-get 'back-left-hand-key-addresses change-points)) (make-right-hand-key-addresses (assoc-get 'back-right-hand-key-addresses change-points)))))) (extra-offset-instructions . ,(append (assoc-get 'cis-offset-instruction change-points) `((,uniform-extra-offset-rule (0.0 . 0.0))))))) (text-commands . ((stencil-alist . ((stencils . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75)) ((stencils . ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0))) ((stencils . ,(make-left-hand-key-addresses '(high-e high-ees ees cis))) (textual? . ,lh-woodwind-text-stencil) (offset . (1.5 . 3.75))) ((stencils . ,(make-left-hand-key-addresses (assoc-get 'back-left-hand-key-addresses change-points))) (textual? . ,rh-woodwind-text-stencil) (offset . (-1.25 . 3.75))) ((stencils . ,(make-right-hand-key-addresses (assoc-get 'front-right-hand-key-addresses change-points))) (textual? . ,lh-woodwind-text-stencil) (offset . (1.5 . 0.0))) ((stencils . ,(make-right-hand-key-addresses (assoc-get 'back-right-hand-key-addresses change-points))) (textual? . ,rh-woodwind-text-stencil) (offset . (-1.25 . 0.0))))) (xy-scale-function . (,identity . ,identity)) (textual? . #f) (offset . (0.0 . 0.0)))) (draw-instructions . ((,apply-group-draw-rule-series (,(make-left-hand-key-addresses (assoc-get 'back-left-hand-key-addresses change-points)) ,(make-right-hand-key-addresses (assoc-get 'front-right-hand-key-addresses change-points)) ,(make-right-hand-key-addresses (assoc-get 'back-right-hand-key-addresses change-points)) ,(make-left-hand-key-addresses '(high-e high-ees ees cis)))) (,group-automate-rule ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST)) (,group-automate-rule ((hidden . midline))))) (extra-offset-instructions . ((,uniform-extra-offset-rule (0.0 . 0.0)))))))))) ;; Assembly functions ; Scans a bank for name. ; for example, '(left-hand . bes) will return bes in the left-hand ; of a given bank (define (get-key name bank) (assoc-get (cdr name) (assoc-get (car name) bank))) (define (translate-key-instruction key-instruction) (let* ((key-name (car key-instruction)) (key-complexity (assoc-get 'complexity (cdr key-instruction)))) (cond ((eqv? key-complexity 'basic) `((,key-name . ,(assoc-get 'F HOLE-FILL-LIST)))) ((eqv? key-complexity 'trill) (make-symbol-alist key-name #t #f)) ((eqv? key-complexity 'covered) (make-symbol-alist key-name #f #f)) ((eqv? key-complexity 'ring) (make-symbol-alist key-name #f #t))))) (define (update-possb-list input-key possibility-list canonic-list) (if (null? possibility-list) (ly:error "woodwind markup error - invalid key or hole requested") (if (assoc-get input-key (cdar possibility-list)) (append `(((,(caaar possibility-list) . ,(assoc-get input-key (cdar possibility-list))) . ,(assoc-get (caar possibility-list) canonic-list))) (assoc-remove (caar possibility-list) canonic-list)) (update-possb-list input-key (cdr possibility-list) canonic-list)))) (define (key-crawler input-list possibility-list) (if (null? input-list) (map car possibility-list) (key-crawler (cdr input-list) (update-possb-list (car input-list) possibility-list possibility-list)))) (define (translate-draw-instructions input-alist key-name-alist) (apply append (map (lambda (short long) (let* ((key-instructions (map (lambda (instr) `(((,long . ,(car instr)) . 0) . ,(translate-key-instruction instr))) (assoc-get long key-name-alist)))) (key-crawler (assoc-get short input-alist) key-instructions))) '(hd cc lh rh) '(hidden central-column left-hand right-hand)))) (define (uniform-draw-instructions key-name-alist) (apply append (map (lambda (long) (map (lambda (key-instructions) `((,long . ,(car key-instructions)) . 1)) (assoc-get long key-name-alist))) '(hidden central-column left-hand right-hand)))) (define (list-all-possible-keys key-name-alist) (map (lambda (short long) `(,short . ,(map (lambda (key-instructions) (car key-instructions)) (assoc-get long key-name-alist)))) '(cc lh rh) '(central-column left-hand right-hand))) (define (list-all-possible-keys-verbose key-name-alist) (map (lambda (short long) `(,short . ,(map (lambda (key-instructions) `(,(car key-instructions) . ,(map (lambda (x) (car x)) (translate-key-instruction key-instructions)))) (assoc-get long key-name-alist)))) '(cc lh rh) '(central-column left-hand right-hand))) (define woodwind-data-assembly-instructions `((,generate-flute-family-entry . piccolo) (,generate-flute-family-entry . flute) (,generate-flute-family-entry . flute-b-extension) (,generate-tin-whistle-family-entry . tin-whistle) (,generate-oboe-family-entry . oboe) (,generate-clarinet-family-entry . clarinet) (,generate-clarinet-family-entry . bass-clarinet) (,generate-clarinet-family-entry . low-bass-clarinet) (,generate-saxophone-family-entry . saxophone) (,generate-saxophone-family-entry . soprano-saxophone) (,generate-saxophone-family-entry . alto-saxophone) (,generate-saxophone-family-entry . tenor-saxophone) (,generate-saxophone-family-entry . baritone-saxophone) (,generate-bassoon-family-entry . bassoon) (,generate-bassoon-family-entry . contrabassoon))) (define-public woodwind-instrument-list (map cdr woodwind-data-assembly-instructions)) (define woodwind-data-alist (map (lambda (instruction) ((car instruction) (cdr instruction))) woodwind-data-assembly-instructions)) ;;; The brains of the markup function: takes drawing and offset information ;;; about a key region and calls the appropriate stencils to draw the region. (define (assemble-stencils stencil-alist key-bank draw-instructions extra-offset-instructions radius thick xy-stretch layout props) (apply ly:stencil-add (map (lambda (node) (ly:stencil-translate (if (pair? (cdr node)) (if (assoc-get 'textual? node) ((assoc-get 'textual? node) (map (lambda (key) (assoc-get 'text? key)) (map (lambda (instr) (get-key instr key-bank)) (assoc-get 'stencils node))) radius (map (lambda (key) (assoc-get key draw-instructions)) (assoc-get 'stencils node)) layout props) (assemble-stencils node key-bank draw-instructions extra-offset-instructions radius thick (coord-apply (assoc-get 'xy-scale-function stencil-alist) xy-stretch) layout props)) (if (= 0 (assoc-get node draw-instructions)) empty-stencil ((assoc-get 'stencil (get-key node key-bank)) radius thick (assoc-get node draw-instructions) layout props))) (coord-scale (coord-translate (coord-scale (assoc-get 'offset (if (pair? (cdr node)) node (get-key node key-bank))) (coord-apply (assoc-get 'xy-scale-function stencil-alist) xy-stretch)) (if (assoc-get node extra-offset-instructions) (assoc-get node extra-offset-instructions) '(0.0 . 0.0))) radius))) (assoc-get 'stencils stencil-alist)))) (define-public (print-keys instrument) (let* ((chosen-instrument (begin (format #t "\nPrinting keys for: ~a\n" instrument) (assoc-get instrument woodwind-data-alist))) (key-list (list-all-possible-keys (assoc-get 'keys chosen-instrument)))) (define (key-list-loop key-list) (if (null? key-list) 0 (begin (format #t "~a\n ~a\n" (caar key-list) (cdar key-list)) (key-list-loop (cdr key-list))))) (key-list-loop key-list))) (define-public (get-woodwind-key-list instrument) (list-all-possible-keys-verbose (assoc-get 'keys (assoc-get instrument woodwind-data-alist)))) (define-public (print-keys-verbose instrument) (let* ((chosen-instrument (begin (format #t "\nPrinting keys in verbose mode for: ~a\n" instrument) (assoc-get instrument woodwind-data-alist))) (key-list (list-all-possible-keys-verbose (assoc-get 'keys chosen-instrument)))) (define (key-list-loop key-list) (if (null? key-list) 0 (begin (format #t "~a\n" (caar key-list)) (map (lambda (x) (format #t " possibilities for ~a:\n ~a\n" (car x) (cdr x))) (cdar key-list)) (key-list-loop (cdr key-list))))) (key-list-loop key-list))) (define-markup-command (woodwind-diagram layout props instrument user-draw-commands) (symbol? list?) #:category instrument-specific-markup ; markup category #:properties ((size 1) (thickness 0.1) (graphical #t)) "Make a woodwind-instrument diagram. For example, say @example \\markup \\woodwind-diagram #'oboe #'((lh . (d ees)) (cc . (five3qT1q)) (rh . (gis))) @end example @noindent for an oboe with the left-hand d key, left-hand ees key, and right-hand gis key depressed while the five-hole of the central column effectuates a trill between 1/4 and 3/4 closed. The following instruments are supported: @itemize @minus @item piccolo @item flute @item oboe @item clarinet @item bass-clarinet @item saxophone @item bassoon @item contrabassoon @end itemize To see all of the callable keys for a given instrument, include the function @code{(print-keys 'instrument)} in your .ly file, where instrument is the instrument whose keys you want to print. Certain keys allow for special configurations. The entire gamut of configurations possible is as follows: @itemize @minus @item 1q (1/4 covered) @item 1h (1/2 covered) @item 3q (3/4 covered) @item R (ring depressed) @item F (fully covered; the default if no state put) @end itemize Additionally, these configurations can be used in trills. So, for example, @code{three3qTR} effectuates a trill between 3/4 full and ring depressed on the three hole. As another example, @code{threeRT} effectuates a trill between R and open, whereas @code{threeTR} effectuates a trill between open and shut. To see all of the possibilities for all of the keys of a given instrument, invoke @code{(print-keys-verbose 'instrument)}. Lastly, substituting an empty list for the pressed-key alist will result in a diagram with all of the keys drawn but none filled. ie... @example \\markup \\woodwind-diagram #'oboe #'() @end example" (let* ((radius size) (thick (* size thickness)) (display-graphic graphical) (xy-stretch `(1.0 . 2.5)) (chosen-instrument (assoc-get instrument woodwind-data-alist)) (chosen-instrument (if (not chosen-instrument) (ly:error "~a is not a valid woodwind instrument." instrument) chosen-instrument)) (stencil-info (assoc-get (if display-graphic 'graphical-commands 'text-commands) chosen-instrument)) (pressed-info (if (null? user-draw-commands) (uniform-draw-instructions (assoc-get 'keys chosen-instrument)) (translate-draw-instructions (append '((hd . ())) user-draw-commands) (assoc-get 'keys chosen-instrument)))) (draw-info (function-chain pressed-info (assoc-get 'draw-instructions stencil-info))) (extra-offset-info (function-chain pressed-info (assoc-get 'extra-offset-instructions stencil-info)))) (assemble-stencils (assoc-get 'stencil-alist stencil-info) (assoc-get 'keys chosen-instrument) draw-info extra-offset-info radius thick xy-stretch layout props)))