LEFT | RIGHT |
1 ;;;; This file is part of LilyPond, the GNU music typesetter. | 1 ;;;; This file is part of LilyPond, the GNU music typesetter. |
2 ;;;; | 2 ;;;; |
3 ;;;; (c) 1998--2012 Han-Wen Nienhuys <hanwen@xs4all.nl> | 3 ;;;; (c) 1998--2012 Han-Wen Nienhuys <hanwen@xs4all.nl> |
4 ;;;; Jan Nieuwenhuizen <janneke@gnu.org> | 4 ;;;; Jan Nieuwenhuizen <janneke@gnu.org> |
5 ;;;; | 5 ;;;; |
6 ;;;; LilyPond is free software: you can redistribute it and/or modify | 6 ;;;; LilyPond is free software: you can redistribute it and/or modify |
7 ;;;; it under the terms of the GNU General Public License as published by | 7 ;;;; it under the terms of the GNU General Public License as published by |
8 ;;;; the Free Software Foundation, either version 3 of the License, or | 8 ;;;; the Free Software Foundation, either version 3 of the License, or |
9 ;;;; (at your option) any later version. | 9 ;;;; (at your option) any later version. |
10 ;;;; | 10 ;;;; |
(...skipping 260 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
271 minimum-fret | 271 minimum-fret |
272 maximum-stretch | 272 maximum-stretch |
273 tuning) | 273 tuning) |
274 "Determine the frets and strings used to play the notes in | 274 "Determine the frets and strings used to play the notes in |
275 @var{notes}, given @var{defined-strings} and @var{defined-fingers} | 275 @var{notes}, given @var{defined-strings} and @var{defined-fingers} |
276 along with @var{minimum-fret}, @var{maximum-stretch}, and | 276 along with @var{minimum-fret}, @var{maximum-stretch}, and |
277 @var{tuning}. Returns a list of @code{(string fret finger) lists." | 277 @var{tuning}. Returns a list of @code{(string fret finger) lists." |
278 | 278 |
279 | 279 |
280 (define restrain-open-strings (ly:context-property context | 280 (define restrain-open-strings (ly:context-property context |
281 » » » » » » 'restrainOpenStrings | 281 » » » » » » 'restrainOpenStrings |
282 » » » » » #f)) | 282 » » » » » #f)) |
283 (define specified-frets '()) | 283 (define specified-frets '()) |
284 (define free-strings (iota (length tuning) 1)) | 284 (define free-strings (iota (length tuning) 1)) |
285 | 285 |
286 (define (calc-fret pitch string tuning) | 286 (define (calc-fret pitch string tuning) |
287 "Calculate the fret to play @var{pitch} on @var{string} with | 287 "Calculate the fret to play @var{pitch} on @var{string} with |
288 @var{tuning}." | 288 @var{tuning}." |
289 (- (ly:pitch-semitones pitch) (ly:pitch-semitones (list-ref tuning (1- str
ing))))) | 289 (- (ly:pitch-semitones pitch) (ly:pitch-semitones (list-ref tuning (1- str
ing))))) |
290 | 290 |
291 (define (note-pitch note) | 291 (define (note-pitch note) |
292 "Get the pitch (in semitones) from @var{note}." | 292 "Get the pitch (in semitones) from @var{note}." |
(...skipping 30 matching lines...) Expand all Loading... |
323 (define (close-enough fret) | 323 (define (close-enough fret) |
324 "Decide if @var{fret} is acceptable, given the already used frets." | 324 "Decide if @var{fret} is acceptable, given the already used frets." |
325 (if (null? specified-frets) | 325 (if (null? specified-frets) |
326 #t | 326 #t |
327 (reduce | 327 (reduce |
328 (lambda (x y) | 328 (lambda (x y) |
329 (and x y)) | 329 (and x y)) |
330 #t | 330 #t |
331 (map (lambda (specced-fret) | 331 (map (lambda (specced-fret) |
332 (or (eq? 0 specced-fret) | 332 (or (eq? 0 specced-fret) |
333 (and (not restrain-open-strings) | 333 » » (and (not restrain-open-strings) |
334 (eq? 0 fret)) | 334 » » (eq? 0 fret)) |
335 (>= maximum-stretch (abs (- fret specced-fret))))) | 335 (>= maximum-stretch (abs (- fret specced-fret))))) |
336 specified-frets)))) | 336 specified-frets)))) |
337 | 337 |
338 (define (string-qualifies string pitch) | 338 (define (string-qualifies string pitch) |
339 "Can @var{pitch} be played on @var{string}, given already placed | 339 "Can @var{pitch} be played on @var{string}, given already placed |
340 notes?" | 340 notes?" |
341 (let* ((fret (calc-fret pitch string tuning))) | 341 (let* ((fret (calc-fret pitch string tuning))) |
342 (and (or (and (not restrain-open-strings) | 342 (and (or (and (not restrain-open-strings) |
343 (eq? fret 0)) | 343 » » (eq? fret 0)) |
344 (>= fret minimum-fret)) | 344 » » (>= fret minimum-fret)) |
345 (close-enough fret)))) | 345 (close-enough fret)))) |
346 | 346 |
347 (define (open-string string pitch) | 347 (define (open-string string pitch) |
348 "Is @var{pitch} and open-string note on @var{string}, given | 348 "Is @var{pitch} and open-string note on @var{string}, given |
349 the current tuning?" | 349 the current tuning?" |
350 (let* ((fret (calc-fret pitch string tuning))) | 350 (let* ((fret (calc-fret pitch string tuning))) |
351 (eq? fret 0))) | 351 (eq? fret 0))) |
352 | 352 |
353 (define (set-fret! pitch-entry string finger) | 353 (define (set-fret! pitch-entry string finger) |
354 (let ((this-fret (calc-fret (car pitch-entry) | 354 (let ((this-fret (calc-fret (car pitch-entry) |
(...skipping 339 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
694 with the subordinate symbols being interfaces." | 694 with the subordinate symbols being interfaces." |
695 (let loop ((forms forms)) | 695 (let loop ((forms forms)) |
696 (if (cheap-list? forms) | 696 (if (cheap-list? forms) |
697 `(list | 697 `(list |
698 ,@(map (lambda (form) | 698 ,@(map (lambda (form) |
699 (if (pair? (car form)) | 699 (if (pair? (car form)) |
700 `(cons ',(caar form) (lambda ,(cdar form) ,@(cdr form))) | 700 `(cons ',(caar form) (lambda ,(cdar form) ,@(cdr form))) |
701 `(cons ',(car form) ,(loop (cdr form))))) | 701 `(cons ',(car form) ,(loop (cdr form))))) |
702 forms)) | 702 forms)) |
703 forms))) | 703 forms))) |
LEFT | RIGHT |