X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdisplay-woodwind-diagrams.scm;h=1737890f5f70088e9228eb026d81c56be4009409;hb=2f84bbe9a6dc6ca2d9a49eae0bf094744e47f11d;hp=51e239235ebd1ab2db1bdfd46b9d66e7e0252aed;hpb=040fcffaf3d2a7e95dc08c4162d32fa5bc37a32d;p=lilypond.git diff --git a/scm/display-woodwind-diagrams.scm b/scm/display-woodwind-diagrams.scm index 51e239235e..1737890f5f 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--2012 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) @@ -668,15 +670,15 @@ ((make-named-spreadsheet '(clarinet bass-clarinet low-bass-clarinet)) `((bottom-group-key-names . (() - ((f + ((ees . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR)))) - (stencil . ,bass-clarinet-rh-f-key-stencil) - (text? . ("F" . #f)) + (stencil . ,bass-clarinet-rh-ees-key-stencil) + (text? . ("E" . 0)) (complexity . trill)))) - ((f + ((ees . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR)))) - (stencil . ,low-bass-clarinet-rh-f-key-stencil) - (text? . ("F" . #f)) + (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)))) @@ -743,11 +745,11 @@ ,(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 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 ees gis)) + . (,(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))))))) @@ -878,22 +880,22 @@ (stencil . ,clarinet-rh-fis-key-stencil) (text? . ("F" . 1)) (complexity . trill))) - (e + (gis . ((offset . (,(+ 1.5 CL-RH-HAIR) . ,(* 3 (+ 0.75 CL-RH-HAIR)))) - (stencil . ,clarinet-rh-e-key-stencil) - (text? . ("E" . #f)) + (stencil . ,clarinet-rh-gis-key-stencil) + (text? . ("G" . 1)) (complexity . trill))) - (ees + (e . ((offset . (0.0 . ,(* 2 (+ 0.75 CL-RH-HAIR)))) - (stencil . ,clarinet-rh-ees-key-stencil) - (text? . ("E" . 0)) + (stencil . ,clarinet-rh-e-key-stencil) + (text? . ("E" . #f)) (complexity . trill))) - (gis + (f . ((offset . (,(+ 1.5 CL-RH-HAIR) . ,(* 1 (+ 0.75 CL-RH-HAIR)))) - (stencil . ,clarinet-rh-gis-key-stencil) - (text? . ("G" . 1)) + (stencil . ,clarinet-rh-f-key-stencil) + (text? . ("F" . #f)) (complexity . trill)))) (assoc-get 'bottom-group-key-names change-points))))) (graphical-commands @@ -1822,20 +1824,14 @@ radius))) (assoc-get 'stencils stencil-alist)))) -(define-public (print-keys instrument) - (let* - ((chosen-instrument - (begin - (format #t "\nPrinting keys for: ~a\n" instrument) - (assoc-get instrument woodwind-data-alist))) - (key-list (list-all-possible-keys (assoc-get 'keys chosen-instrument)))) - (define (key-list-loop key-list) - (if (null? key-list) - 0 - (begin - (format #t "~a\n ~a\n" (caar key-list) (cdar key-list)) - (key-list-loop (cdr key-list))))) - (key-list-loop key-list))) +(define*-public (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 @@ -1843,33 +1839,30 @@ 'keys (assoc-get instrument woodwind-data-alist)))) -(define-public (print-keys-verbose instrument) - (let* - ((chosen-instrument - (begin - (format #t "\nPrinting keys in verbose mode for: ~a\n" instrument) - (assoc-get instrument woodwind-data-alist))) - (key-list - (list-all-possible-keys-verbose (assoc-get 'keys chosen-instrument)))) - (define (key-list-loop key-list) - (if (null? key-list) - 0 - (begin - (format #t "~a\n" (caar key-list)) - (map (lambda (x) - (format #t " possibilities for ~a:\n ~a\n" (car x) (cdr x))) - (cdar key-list)) - (key-list-loop (cdr key-list))))) - (key-list-loop key-list))) +(define*-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,47 +1934,46 @@ 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 - (assoc-get 'stencil-alist stencil-info) - (assoc-get 'keys chosen-instrument) - draw-info - extra-offset-info - radius - thick - xy-stretch - layout - props))) \ No newline at end of file + (let* ((radius size) + (thick (* size thickness)) + (display-graphic graphical) + (xy-stretch `(1.0 . 2.5)) + (chosen-instrument (assoc-get instrument woodwind-data-alist)) + (chosen-instrument + (if (not chosen-instrument) + (ly:error "~a is not a valid woodwind instrument." + instrument) + chosen-instrument)) + (stencil-info + (assoc-get + (if display-graphic 'graphical-commands 'text-commands) + chosen-instrument)) + (pressed-info + (if (null? user-draw-commands) + (uniform-draw-instructions (assoc-get 'keys chosen-instrument)) + (translate-draw-instructions + (append '((hd . ())) user-draw-commands) + (assoc-get 'keys chosen-instrument)))) + (draw-info + (function-chain + pressed-info + (assoc-get 'draw-instructions stencil-info))) + (extra-offset-info + (function-chain + pressed-info + (assoc-get 'extra-offset-instructions stencil-info)))) + (assemble-stencils + (assoc-get 'stencil-alist stencil-info) + (assoc-get 'keys chosen-instrument) + draw-info + extra-offset-info + radius + thick + xy-stretch + layout + props)))