X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdisplay-woodwind-diagrams.scm;h=987b79814260d511e117472107a5238a8734f044;hb=9e781b7dc83b60a543ce218aa1a5f139f74c760f;hp=51e239235ebd1ab2db1bdfd46b9d66e7e0252aed;hpb=040fcffaf3d2a7e95dc08c4162d32fa5bc37a32d;p=lilypond.git diff --git a/scm/display-woodwind-diagrams.scm b/scm/display-woodwind-diagrams.scm index 51e239235e..987b798142 100644 --- a/scm/display-woodwind-diagrams.scm +++ b/scm/display-woodwind-diagrams.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2010 Mike Solomon +;;;; Copyright (C) 2010--2014 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 @@ -29,6 +29,8 @@ ;; Utility functions +(use-modules (ice-9 optargs)) + (define (return-1 x) 1.0) (define (make-spreadsheet parameter-list) @@ -62,10 +64,10 @@ (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)))) + . ,(map (lambda (name element) + `(,name . ,element)) + parameter-list + (list-tail list-to-translate 1)))) ls))) (define (get-named-spreadsheet-column column spreadsheet) @@ -75,8 +77,8 @@ @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)) + (lambda (row) (cons (car row) (assoc-get column (cdr row)))) + spreadsheet)) (define make-key-alist (make-named-spreadsheet '(name offset graphical textual))) @@ -92,8 +94,8 @@ (define (make-central-column-hole-addresses keys) "Takes @code{keys} and ascribes them to the central column." (map - (lambda (key) `(central-column . ,key)) - keys)) + (lambda (key) `(central-column . ,key)) + keys)) (define (make-key-symbols hand) "Takes @code{hand} and ascribes @code{key} to it." @@ -109,63 +111,63 @@ (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-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)))) + . (((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))) + '(ees cis c))) (,rich-group-draw-rule ((right-hand . gz)) ,(make-right-hand-key-addresses - '(ees cis c b))))) + '(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)) @@ -175,153 +177,153 @@ (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 + 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 + (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)))))))))) + (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 @@ -330,87 +332,87 @@ (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)))))))))) + ((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 @@ -419,600 +421,600 @@ (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)))))))))) + ((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 - . (() - ((f - . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR)))) - (stencil . ,bass-clarinet-rh-f-key-stencil) - (text? . ("F" . #f)) - (complexity . trill)))) - ((f - . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR)))) - (stencil . ,low-bass-clarinet-rh-f-key-stencil) - (text? . ("F" . #f)) - (complexity . trill))) - (d - . ((offset . (,(+ 1.5 CL-RH-HAIR) . ,(* -1 (+ 0.75 CL-RH-HAIR)))) - (stencil . ,clarinet-rh-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 - . (() - () - ((d - . ((offset . (4.0 . -0.8)) - (stencil . ,clarinet-lh-d-key-stencil) - (text? . ("D" . #f)) - (complexity . trill)))))) - (right-thumb-group - . (() - () - (((stencils + `((bottom-group-key-names + . (() + ((ees + . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR)))) + (stencil . ,bass-clarinet-rh-ees-key-stencil) + (text? . ("E" . 0)) + (complexity . trill)))) + ((ees + . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR)))) + (stencil . ,low-bass-clarinet-rh-ees-key-stencil) + (text? . ("E" . 0)) + (complexity . trill))) + (d + . ((offset . (,(+ 1.5 CL-RH-HAIR) . ,(* -1 (+ 0.75 CL-RH-HAIR)))) + (stencil . ,clarinet-rh-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 + . (() + () + ((d + . ((offset . (4.0 . -0.8)) + (stencil . ,clarinet-lh-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 d)))) - (all-left-hand-key-addresses - . (,(make-left-hand-key-addresses '(a gis ees cis f e fis)) - ,(make-left-hand-key-addresses '(a gis ees cis f e fis)) - ,(make-left-hand-key-addresses '(a gis ees cis f e fis d)))) - (low-key-group - . (() - () - (,(make-right-hand-key-addresses '(low-c low-cis))))) - (low-rich-draw-rules - . (() - () - ((,rich-group-draw-rule - ((left-hand . d)) - ,(make-left-hand-key-addresses '(cis f 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 e ees gis)) - ,(make-right-hand-key-addresses '(fis e ees gis f)) - ,(make-right-hand-key-addresses '(fis e ees gis f d)))) - (right-hand-key-addresses - . (,(make-right-hand-key-addresses '(fis e ees gis)) - ,(make-right-hand-key-addresses '(fis e ees gis f)) - ,(make-right-hand-key-addresses - '(low-d low-cis low-c fis e ees gis f d))))))) + (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 d)))) + (all-left-hand-key-addresses + . (,(make-left-hand-key-addresses '(a gis ees cis f e fis)) + ,(make-left-hand-key-addresses '(a gis ees cis f e fis)) + ,(make-left-hand-key-addresses '(a gis ees cis f e fis d)))) + (low-key-group + . (() + () + (,(make-right-hand-key-addresses '(low-c low-cis))))) + (low-rich-draw-rules + . (() + () + ((,rich-group-draw-rule + ((left-hand . d)) + ,(make-left-hand-key-addresses '(cis f 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 e f gis)) + ,(make-right-hand-key-addresses '(fis e ees gis f)) + ,(make-right-hand-key-addresses '(fis e ees gis f d)))) + (right-hand-key-addresses + . (,(make-right-hand-key-addresses '(fis e f gis)) + ,(make-right-hand-key-addresses '(fis e ees gis f)) + ,(make-right-hand-key-addresses + '(low-d low-cis low-c fis e ees gis f 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))) - (ees - . ((offset . (0.0 . 0.0)) - (stencil . ,clarinet-lh-ees-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-e-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))) - (e - . ((offset . (,(+ 1.5 CL-RH-HAIR) - . ,(* 3 (+ 0.75 CL-RH-HAIR)))) - (stencil . ,clarinet-rh-e-key-stencil) - (text? . ("E" . #f)) - (complexity . trill))) - (ees - . ((offset . (0.0 . ,(* 2 (+ 0.75 CL-RH-HAIR)))) - (stencil . ,clarinet-rh-ees-key-stencil) - (text? . ("E" . 0)) - (complexity . trill))) - (gis - . ((offset . (,(+ 1.5 CL-RH-HAIR) - . ,(* 1 (+ 0.75 CL-RH-HAIR)))) - (stencil . ,clarinet-rh-gis-key-stencil) - (text? . ("G" . 1)) - (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 . ees) - '(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 + ((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))) + (ees + . ((offset . (0.0 . 0.0)) + (stencil . ,clarinet-lh-ees-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-e-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" . 1)) + (complexity . trill))) + (e + . ((offset . (0.0 . ,(* 2 (+ 0.75 CL-RH-HAIR)))) + (stencil . ,clarinet-rh-e-key-stencil) + (text? . ("E" . #f)) + (complexity . trill))) + (f + . ((offset . (,(+ 1.5 CL-RH-HAIR) + . ,(* 1 (+ 0.75 CL-RH-HAIR)))) + (stencil . ,clarinet-rh-f-key-stencil) + (text? . ("F" . #f)) + (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 . ees) + '(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 + ,(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 + (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)))))))))) + (,uniform-extra-offset-rule (0.0 . 0.0)))))))))) ;; Saxophone assembly instructions @@ -1025,683 +1027,681 @@ (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-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))))) + . (() + (,(simple-stencil-alist '(left-hand . low-a) '(-5.0 . 7.0))))) (low-a-presence - . (() - ((left-hand . low-a)))) + . (() + ((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))))))) + . (,(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 + ((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)))))))))) + (,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-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 . 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)))) + (((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))) - ())) + (((,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 . thumb-gis) (right-hand . thumb-fis)) + ((right-hand . thumb-fis)))) (right-hand-cis-key . - ((,(simple-stencil-alist '(right-hand . cis) '(-2.3 . 3.22))) - ())) + ((,(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))) + ((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))) + ((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)))))) + ((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 + ((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 + (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 + (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 + (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 + ,(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)))))))))) + ,(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 +;; 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 (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))))) + ((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 + (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)))) + ,(assoc-get (caar possibility-list) canonic-list))) + (alist-delete (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 + (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)))) + (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)))) + (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) @@ -1754,122 +1754,113 @@ (define (assemble-stencils - stencil-alist - key-bank - draw-instructions - extra-offset-instructions - radius - thick - xy-stretch - layout - props) + 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)) + 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))) + radius + thick + (assoc-get node draw-instructions) + layout + props))) + (coord-scale + (coord-translate (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))) + (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 #:optional (port (current-output-port))) + (format port "\nPrinting keys for: ~a\n" instrument) + (let ((chosen-instrument (assoc-get instrument woodwind-data-alist))) + (do ((key-list + (list-all-possible-keys (assoc-get 'keys chosen-instrument)) + (cdr key-list))) + ((null? key-list)) + (format port "~a\n ~a\n" (caar key-list) (cdar 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))) + (assoc-get + 'keys + (assoc-get instrument woodwind-data-alist)))) + +(define*-public (print-keys-verbose instrument + #:optional (port (current-output-port))) + (format port "\nPrinting keys in verbose mode for: ~a\n" instrument) + (do ((key-list (get-woodwind-key-list instrument) + (cdr key-list))) + ((null? key-list)) + (format port "~a\n" (caar key-list)) + (for-each + (lambda (x) + (format port " possibilities for ~a:\n ~a\n" (car x) (cdr x))) + (cdar key-list)))) (define-markup-command - (woodwind-diagram layout props instrument input-list) + (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 #'(1.4 0.1 #t ((lh . (d ees)) (cc . (five3qT1q)) (rh . (gis)))) +\\markup \\woodwind-diagram + #'oboe #'((lh . (d ees)) (cc . (five3qT1q)) (rh . (gis))) @end example @noindent @@ -1941,41 +1932,40 @@ 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... +a diagram with all of the keys drawn but none filled, for example: @example -\\markup \\woodwind-diagram #'oboe #'(1.4 0.1 #t ()) +\\markup \\woodwind-diagram #'oboe #'() @end example" - (let* ((radius (car input-list)) - (thick (cadr input-list)) - (display-graphic (caddr input-list)) - (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)) - (user-draw-commands (cadddr input-list)) - (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 + (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 @@ -1984,4 +1974,4 @@ a diagram with all of the keys drawn but none filled. ie... thick xy-stretch layout - props))) \ No newline at end of file + props)))