Left: | ||
Right: |
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 ;;;; Copyright (C) 1998--2010 Jan Nieuwenhuizen <janneke@gnu.org> | 3 ;;;; Copyright (C) 1998--2010 Jan Nieuwenhuizen <janneke@gnu.org> |
4 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl> | 4 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl> |
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 262 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... | |
273 (let ((k (assoc (car keys) lst))) | 273 (let ((k (assoc (car keys) lst))) |
274 (if k k (first-assoc (cdr keys) lst))))) | 274 (if k k (first-assoc (cdr keys) lst))))) |
275 | 275 |
276 (define-public (flatten-alist alist) | 276 (define-public (flatten-alist alist) |
277 (if (null? alist) | 277 (if (null? alist) |
278 '() | 278 '() |
279 (cons (caar alist) | 279 (cons (caar alist) |
280 (cons (cdar alist) | 280 (cons (cdar alist) |
281 (flatten-alist (cdr alist)))))) | 281 (flatten-alist (cdr alist)))))) |
282 | 282 |
283 (define-public (map-alist-keys function keys alist) | 283 (define (assoc-remove key alist) |
Neil Puttock
2010/05/31 14:48:13
this needs renaming: there's already a function ca
| |
284 "Remove key (and its corresponding value) from an alist. | |
285 Different than assoc-remove! because it is non-destructive." | |
286 (define (assoc-crawler key l r) | |
287 (if (null? r) | |
288 l | |
289 (if (equal? (caar r) key) | |
290 (append l (cdr r)) | |
291 (assoc-crawler key (append l `(,(car r))) (cdr r))))) | |
292 (assoc-crawler key '() alist)) | |
293 | |
294 (define-public (map-selected-alist-keys function keys alist) | |
284 "Returns alist with function applied to all of the values in list keys. | 295 "Returns alist with function applied to all of the values in list keys. |
285 For example: | 296 For example: |
286 @code{guile> (map-alist-keys - '(a b) '((a . 1) (b . -2) (c . 3) (d . 4)))} | 297 @code{guile> (map-selected-alist-keys - '(a b) '((a . 1) (b . -2) (c . 3) (d . 4)))} |
287 @code{((a . -1) (b . 2) (c . 3) (d . 4))}" | 298 @code{((a . -1) (b . 2) (c . 3) (d . 4))}" |
Neil Puttock
2010/05/31 14:48:13
the order's not preserved; I get the following out
| |
288 (if (null? keys) | 299 (define (map-selected-alist-keys-helper function key alist) |
289 alist | 300 (map |
Neil Puttock
2010/05/31 14:48:13
(if (null? keys)
alist
(and all other `if' fo
| |
290 (if (assoc (car keys) alist) | 301 (lambda (pair) |
291 (map-alist-keys | 302 (if (equal? key (car pair)) |
292 function | 303 (cons key (function (cdr pair))) |
293 (cdr keys) | 304 pair)) |
294 (append | 305 alist)) |
295 `((,(car keys) . ,(function (assoc-get (car keys) alist)))) | 306 (if (null? keys) |
296 (assoc-remove (car keys) alist))) | 307 alist |
Neil Puttock
2010/05/31 14:48:13
assoc-remove should be defined in this file, not i
| |
297 (map-alist-keys function (cdr keys) alist)))) | 308 (map-selected-alist-keys |
309 function | |
310 (cdr keys) | |
311 (map-selected-alist-keys-helper function (car keys) alist)))) | |
298 | 312 |
299 ;;;;;;;;;;;;;;;; | 313 ;;;;;;;;;;;;;;;; |
300 ;; vector | 314 ;; vector |
301 | 315 |
302 (define-public (vector-for-each proc vec) | 316 (define-public (vector-for-each proc vec) |
303 (do | 317 (do |
304 ((i 0 (1+ i))) | 318 ((i 0 (1+ i))) |
305 ((>= i (vector-length vec)) vec) | 319 ((>= i (vector-length vec)) vec) |
306 (vector-set! vec i (proc (vector-ref vec i))))) | 320 (vector-set! vec i (proc (vector-ref vec i))))) |
307 | 321 |
(...skipping 172 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... | |
480 (define-public (interval-center x) | 494 (define-public (interval-center x) |
481 "Center the number-pair X, when an interval" | 495 "Center the number-pair X, when an interval" |
482 (if (interval-empty? x) | 496 (if (interval-empty? x) |
483 0.0 | 497 0.0 |
484 (/ (+ (car x) (cdr x)) 2))) | 498 (/ (+ (car x) (cdr x)) 2))) |
485 | 499 |
486 (define-public interval-start car) | 500 (define-public interval-start car) |
487 | 501 |
488 (define-public interval-end cdr) | 502 (define-public interval-end cdr) |
489 | 503 |
490 (define (interval-operation operator operand interval) | |
491 (if (pair? operand) | |
492 (cons | |
Carl
2010/05/31 14:06:49
In general, I prefer to have the first argument on
| |
493 (operator (interval-start operand) (interval-start interval)) | |
494 (operator (interval-end operand) (interval-end interval))) | |
Neil Puttock
2010/05/31 14:48:13
(cons (operator (interval-start operand) (interval
| |
495 (cons | |
496 (operator operand (interval-start interval)) | |
497 (operator operand (interval-end interval))))) | |
498 | |
499 (define (interval-apply function interval) | |
500 (if (pair? function) | |
501 (cons | |
502 ((interval-start function) (interval-start interval)) | |
503 ((interval-end function) (interval-end interval))) | |
504 (cons | |
505 (function (interval-start interval)) | |
506 (function (interval-end interval))))) | |
507 | |
508 (define-public (interval-translate interval amount) | |
509 (interval-operation + amount interval)) | |
510 | |
511 (define-public (interval-scale interval amount) | |
512 (interval-operation * amount interval)) | |
513 | |
514 (define-public (interval-rotate interval degrees-in-radians) | |
Carl
2010/05/31 14:06:49
This looks like you're using an interval as an x-y
| |
515 (let* | |
516 ((interval | |
517 (cons | |
518 (exact->inexact (interval-start interval)) | |
519 (exact->inexact (interval-end interval)))) | |
520 (radius | |
Carl
2010/05/31 14:06:49
(radius should line up with (interval, not ((inter
| |
521 (sqrt | |
522 (+ | |
Carl
2010/05/31 17:47:29
You might want to define some functions (perhaps i
| |
523 (* (interval-start interval) (interval-start interval)) | |
524 (* (interval-end interval) (interval-end interval))))) | |
525 (angle | |
526 (if | |
527 (eqv? (interval-start interval) 0.0) | |
Carl
2010/05/31 17:47:29
You can avoid all these tests by just using the tw
| |
528 (if | |
529 (>= (interval-end interval) 0) | |
530 (/ PI 2) | |
531 (* 3 (/ PI 2))) | |
532 (+ | |
533 (atan (/ (interval-end interval) (interval-start interval))) | |
534 (if (< (interval-start interval) 0) PI 0))))) | |
535 (cons | |
536 (* radius (cos (+ angle degrees-in-radians))) | |
537 (* radius (sin (+ angle degrees-in-radians)))))) | |
538 | |
539 (define (other-axis a) | 504 (define (other-axis a) |
540 (remainder (+ a 1) 2)) | 505 (remainder (+ a 1) 2)) |
541 | 506 |
542 (define-public (interval-widen iv amount) | 507 (define-public (interval-widen iv amount) |
543 (cons (- (car iv) amount) | 508 (cons (- (car iv) amount) |
544 (+ (cdr iv) amount))) | 509 (+ (cdr iv) amount))) |
545 | 510 |
546 (define-public (interval-empty? iv) | 511 (define-public (interval-empty? iv) |
547 (> (car iv) (cdr iv))) | 512 (> (car iv) (cdr iv))) |
548 | 513 |
(...skipping 14 matching lines...) Expand all Loading... | |
563 (inf? (cdr i)) | 528 (inf? (cdr i)) |
564 (> (car i) (cdr i))))) | 529 (> (car i) (cdr i))))) |
565 | 530 |
566 (define-public (add-point interval p) | 531 (define-public (add-point interval p) |
567 (cons (min (interval-start interval) p) | 532 (cons (min (interval-start interval) p) |
568 (max (interval-end interval) p))) | 533 (max (interval-end interval) p))) |
569 | 534 |
570 (define-public (reverse-interval iv) | 535 (define-public (reverse-interval iv) |
571 (cons (cdr iv) (car iv))) | 536 (cons (cdr iv) (car iv))) |
572 | 537 |
573 (define-public (return-interval iv) iv) | 538 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
Neil Puttock
2010/05/31 14:48:13
= Guile's `identity' procedure
| |
539 ;; coordinates | |
540 | |
541 (define coord-x car) | |
542 (define coord-y cdr) | |
543 | |
544 (define (coord-operation operator operand coordinate) | |
545 (if (pair? operand) | |
546 (cons (operator (coord-x operand) (coord-x coordinate)) | |
547 (operator (coord-y operand) (coord-y coordinate))) | |
548 (cons (operator operand (coord-x coordinate)) | |
549 (operator operand (coord-y coordinate))))) | |
550 | |
551 (define (coord-apply function coordinate) | |
552 (if (pair? function) | |
553 (cons | |
554 ((coord-x function) (coord-x coordinate)) | |
555 ((coord-y function) (coord-y coordinate))) | |
556 (cons | |
557 (function (coord-x coordinate)) | |
558 (function (coord-y coordinate))))) | |
559 | |
560 (define-public (coord-translate coordinate amount) | |
561 (coord-operation + amount coordinate)) | |
562 | |
563 (define-public (coord-scale coordinate amount) | |
564 (coord-operation * amount coordinate)) | |
565 | |
566 (define-public (coord-rotate coordinate degrees-in-radians) | |
567 (let* | |
568 ((coordinate | |
569 (cons | |
570 (exact->inexact (coord-x coordinate)) | |
571 (exact->inexact (coord-y coordinate)))) | |
572 (radius | |
573 (sqrt | |
574 (+ (* (coord-x coordinate) (coord-x coordinate)) | |
575 (* (coord-y coordinate) (coord-y coordinate))))) | |
576 (angle (angle-0-2pi (atan (coord-y coordinate) (coord-x coordinate))))) | |
577 (cons | |
578 (* radius (cos (+ angle degrees-in-radians))) | |
579 (* radius (sin (+ angle degrees-in-radians)))))) | |
574 | 580 |
575 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 581 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
576 ;; trig | 582 ;; trig |
577 | 583 |
Patrick McCarty
2010/06/18 22:42:00
If you want to use these procedures in output-svg.
| |
578 (define PI (* 4 (atan 1))) | 584 (define PI (* 4 (atan 1))) |
579 | 585 |
580 (define TWO-PI (* 2 PI)) | 586 (define TWO-PI (* 2 PI)) |
581 | 587 |
582 (define PI-OVER-TWO (/ PI 2)) | 588 (define PI-OVER-TWO (/ PI 2)) |
583 | 589 |
584 (define THREE-PI-OVER-TWO (* 3 PI-OVER-TWO)) | 590 (define THREE-PI-OVER-TWO (* 3 PI-OVER-TWO)) |
585 | 591 |
586 (define (cyclic-base-value value cycle) | 592 (define (cyclic-base-value value cycle) |
587 "Takes a value and modulo-maps it between 0 and base." | 593 "Takes a value and modulo-maps it between 0 and base." |
588 (if | 594 (if (< value 0) |
Carl
2010/05/31 14:06:49
It's more standard practice to put the test on the
| |
589 (< value 0) | 595 (cyclic-base-value (+ value cycle) cycle) |
590 (cyclic-base-value (+ value cycle) cycle) | 596 (if (>= value cycle) |
591 (if (>= value cycle) | 597 (cyclic-base-value (- value cycle) cycle) |
592 (cyclic-base-value (- value cycle) cycle) | 598 value))) |
593 value))) | |
594 | 599 |
595 (define (angle-0-2pi angle) | 600 (define (angle-0-2pi angle) |
596 "Takes an angle in radians and maps it between 0 and 2pi." | 601 "Takes an angle in radians and maps it between 0 and 2pi." |
597 (cyclic-base-value angle TWO-PI)) | 602 (cyclic-base-value angle TWO-PI)) |
598 | 603 |
599 (define (angle-0-360 angle) | 604 (define (angle-0-360 angle) |
600 "Takes an angle in radians and maps it between 0 and 2pi." | 605 "Takes an angle in radians and maps it between 0 and 2pi." |
601 (cyclic-base-value angle 360.0)) | 606 (cyclic-base-value angle 360.0)) |
602 | 607 |
603 (define PI-OVER-180 (/ PI 180)) | 608 (define PI-OVER-180 (/ PI 180)) |
604 | 609 |
605 (define (degrees->radians angle-degrees) | 610 (define (degrees->radians angle-degrees) |
606 "Convert the given angle from degrees to radians" | 611 "Convert the given angle from degrees to radians" |
607 (* angle-degrees PI-OVER-180)) | 612 (* angle-degrees PI-OVER-180)) |
608 | 613 |
609 (define (ellipse-radius x-radius y-radius angle) | 614 (define (ellipse-radius x-radius y-radius angle) |
610 (/ | 615 (/ |
Carl
2010/05/31 14:06:49
I think you should not have the operators by thems
| |
611 (* x-radius y-radius) | 616 (* x-radius y-radius) |
612 (sqrt | 617 (sqrt |
613 (+ | 618 (+ (* (expt y-radius 2) |
614 (* | 619 (* (cos angle) (cos angle))) |
615 (expt y-radius 2) | 620 (* (expt x-radius 2) |
616 (* (cos angle) (cos angle))) | 621 (* (sin angle) (sin angle))))))) |
617 (* | |
618 (expt x-radius 2) | |
619 (* (sin angle) (sin angle))))))) | |
620 | 622 |
621 (define (polar->rectangular radius angle-in-degrees) | 623 (define (polar->rectangular radius angle-in-degrees) |
622 "Convert polar coordinate @code{radius} and @code{angle-in-degrees} | 624 "Convert polar coordinate @code{radius} and @code{angle-in-degrees} |
623 to (x-length . y-length)" | 625 to (x-length . y-length)" |
624 (let* ((complex (make-polar | 626 (let ((complex (make-polar |
Neil Puttock
2010/05/31 14:48:13
let
| |
625 radius | 627 radius |
626 (degrees->radians angle-in-degrees)))) | 628 (degrees->radians angle-in-degrees)))) |
627 (cons | 629 (cons |
628 (real-part complex) | 630 (real-part complex) |
629 (imag-part complex)))) | 631 (imag-part complex)))) |
630 | 632 |
631 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 633 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
632 ;; string | 634 ;; string |
633 | 635 |
634 (define-public (string-endswith s suffix) | 636 (define-public (string-endswith s suffix) |
(...skipping 107 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... | |
742 (get-val (getter compare))) | 744 (get-val (getter compare))) |
743 (cond | 745 (cond |
744 ((< target-val get-val) | 746 ((< target-val get-val) |
745 (set! end (1- compare))) | 747 (set! end (1- compare))) |
746 ((< get-val target-val) | 748 ((< get-val target-val) |
747 (set! start (1+ compare)))) | 749 (set! start (1+ compare)))) |
748 (binary-search start end getter target-val)))) | 750 (binary-search start end getter target-val)))) |
749 | 751 |
750 (define-public (car< a b) | 752 (define-public (car< a b) |
751 (< (car a) (car b))) | 753 (< (car a) (car b))) |
754 | |
755 (define-public (car<= a b) | |
756 (<= (car a) (car b))) | |
752 | 757 |
753 (define-public (symbol<? lst r) | 758 (define-public (symbol<? lst r) |
754 (string<? (symbol->string lst) (symbol->string r))) | 759 (string<? (symbol->string lst) (symbol->string r))) |
755 | 760 |
756 (define-public (symbol-key<? lst r) | 761 (define-public (symbol-key<? lst r) |
757 (string<? (symbol->string (car lst)) (symbol->string (car r)))) | 762 (string<? (symbol->string (car lst)) (symbol->string (car r)))) |
758 | 763 |
759 (define-public (eval-carefully symbol module . default) | 764 (define-public (eval-carefully symbol module . default) |
760 "Check if all symbols in expr SYMBOL are reachable | 765 "Check if all symbols in expr SYMBOL are reachable |
761 in module MODULE. In that case evaluate, otherwise | 766 in module MODULE. In that case evaluate, otherwise |
(...skipping 72 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... | |
834 (format #f | 839 (format #f |
835 (_ "no \\version statement found, please add~afor future compatibili ty") | 840 (_ "no \\version statement found, please add~afor future compatibili ty") |
836 (format #f "\n\n\\version ~s\n\n" (lilypond-version))))) | 841 (format #f "\n\n\\version ~s\n\n" (lilypond-version))))) |
837 | 842 |
838 (define-public (old-relative-not-used-message input-file-name) | 843 (define-public (old-relative-not-used-message input-file-name) |
839 (ly:message | 844 (ly:message |
840 "~a:0: ~a ~a" | 845 "~a:0: ~a ~a" |
841 input-file-name | 846 input-file-name |
842 (_ "warning:") | 847 (_ "warning:") |
843 (_ "old relative compatibility not used"))) | 848 (_ "old relative compatibility not used"))) |
LEFT | RIGHT |