X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily-library.scm;h=0746876ca3d6625d9c678c857618fe38f8ebf00a;hb=5ed10e40db547f70f6f5b3ae2092ab0997d89fa3;hp=3575e13264db2bfe53a05633b45d05a501d523fe;hpb=fee3b506770ea5fa8e3ec6078795d1ede16244ec;p=lilypond.git diff --git a/scm/lily-library.scm b/scm/lily-library.scm index 3575e13264..0746876ca3 100644 --- a/scm/lily-library.scm +++ b/scm/lily-library.scm @@ -6,6 +6,8 @@ ;;;; (c) 1998--2006 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; constants. (define-public X 0) (define-public Y 1) @@ -17,57 +19,58 @@ (define-public DOWN -1) (define-public CENTER 0) -(define-safe-public DOUBLE-FLAT -4) -(define-safe-public THREE-Q-FLAT -3) -(define-safe-public FLAT -2) -(define-safe-public SEMI-FLAT -1) +(define-safe-public DOUBLE-FLAT-QTS -4) +(define-safe-public THREE-Q-FLAT-QTS -3) +(define-safe-public FLAT-QTS -2) +(define-safe-public SEMI-FLAT-QTS -1) +(define-safe-public NATURAL-QTS 0) +(define-safe-public SEMI-SHARP-QTS 1) +(define-safe-public SHARP-QTS 2) +(define-safe-public THREE-Q-SHARP-QTS 3) +(define-safe-public DOUBLE-SHARP-QTS 4) +(define-safe-public SEMI-TONE-QTS 2) + +(define-safe-public DOUBLE-FLAT -1) +(define-safe-public THREE-Q-FLAT -3/4) +(define-safe-public FLAT -1/2) +(define-safe-public SEMI-FLAT -1/4) (define-safe-public NATURAL 0) -(define-safe-public SEMI-SHARP 1) -(define-safe-public SHARP 2) -(define-safe-public THREE-Q-SHARP 3) -(define-safe-public DOUBLE-SHARP 4) -(define-safe-public SEMI-TONE 2) +(define-safe-public SEMI-SHARP 1/4) +(define-safe-public SHARP 1/2) +(define-safe-public THREE-Q-SHARP 3/4) +(define-safe-public DOUBLE-SHARP 1) +(define-safe-public SEMI-TONE 1/2) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; moments (define-public ZERO-MOMENT (ly:make-moment 0 1)) (define-public (moment-min a b) (if (ly:moment output hooks. -(define-public (print-score-as-book parser score) - (let* ((head (ly:parser-lookup parser '$defaultheader)) - (book (ly:make-book (ly:parser-lookup parser '$defaultpaper) - head score))) - (print-book-with-defaults parser book))) - -(define-public (print-score parser score) - (let* ((head (ly:parser-lookup parser '$defaultheader)) - (book (ly:make-book (ly:parser-lookup parser '$defaultpaper) - head score))) - (ly:parser-print-score parser book))) (define-public (collect-scores-for-book parser score) (ly:parser-define! parser 'toplevel-scores (cons score (ly:parser-lookup parser 'toplevel-scores)))) +(define-public (collect-music-for-book parser music) + ;; discard music if its 'void property is true. + (let ((void-music (ly:music-property music 'void))) + (if (or (null? void-music) (not void-music)) + (collect-scores-for-book parser (scorify-music music parser))))) (define-public (scorify-music music parser) + "Preprocess MUSIC." (for-each (lambda (func) (set! music (func music parser))) @@ -75,38 +78,15 @@ (ly:make-score music)) -(define-public (collect-music-for-book parser music) - ;; discard music if its 'void property is true. - (let ((void-music (ly:music-property music 'void))) - (if (or (null? void-music) (not void-music)) - (collect-scores-for-book parser (scorify-music music parser))))) - - -(define-public (print-book-with-defaults parser book) +(define (print-book-with parser book process-procedure) (let* ((paper (ly:parser-lookup parser '$defaultpaper)) (layout (ly:parser-lookup parser '$defaultlayout)) - (count (ly:parser-lookup parser 'output-count)) - (base (ly:parser-output-name parser))) - - (if (not (integer? count)) - (set! count 0)) - (if (> count 0) - (set! base (format #f "~a-~a" base count))) - - (ly:parser-define! parser 'output-count (1+ count)) - (ly:book-process book paper layout base) - )) - -(define-public (print-score-with-defaults parser score) - (let* - ((paper (ly:parser-lookup parser '$defaultpaper)) - (layout (ly:parser-lookup parser '$defaultlayout)) - (header (ly:parser-lookup parser '$defaultheader)) (count (ly:parser-lookup parser 'output-count)) (base (ly:parser-output-name parser))) + ;; must be careful: output-count is under user control. (if (not (integer? count)) (set! count 0)) @@ -114,12 +94,18 @@ (set! base (format #f "~a-~a" base count))) (ly:parser-define! parser 'output-count (1+ count)) - (ly:score-process score header paper layout base) + (process-procedure book paper layout base) )) +(define-public (print-book-with-defaults parser book) + (print-book-with parser book ly:book-process)) + +(define-public (print-book-with-defaults-as-systems parser book) + (print-book-with parser book ly:book-process-to-systems)) ;;;;;;;;;;;;;;;; ;; alist + (define-public assoc-get ly:assoc-get) (define-public (uniqued-alist alist acc) @@ -192,6 +178,7 @@ found." ;;;;;;;;;;;;;;;; ;; vector + (define-public (vector-for-each proc vec) (do ((i 0 (1+ i))) @@ -201,24 +188,9 @@ found." ;;;;;;;;;;;;;;;; ;; hash -(if (not (defined? 'hash-table?)) ;; guile 1.6 compat - (begin - (define hash-table? vector?) - (define-public (hash-for-each proc tab) - (hash-fold (lambda (k v prior) - (proc k v) - #f) - #f - tab)) - (define-public (hash-table->alist t) - "Convert table t to list" - (apply append (vector->list t)))) - - ;; native hashtabs. - (begin - (define-public (hash-table->alist t) - (hash-fold (lambda (k v acc) (acons k v acc)) - '() t)))) +(define-public (hash-table->alist t) + (hash-fold (lambda (k v acc) (acons k v acc)) + '() t)) ;; todo: code dup with C++. (define-safe-public (alist->hash-table lst) @@ -230,6 +202,18 @@ found." ;;;;;;;;;;;;;;;; ;; list +(define (functional-or . rest) + (if (pair? rest) + (or (car rest) + (apply functional-and (cdr rest))) + #f)) + +(define (functional-and . rest) + (if (pair? rest) + (and (car rest) + (apply functional-and (cdr rest))) + #t)) + (define (split-list lst n) "Split LST in N equal sized parts" @@ -257,6 +241,7 @@ found." (define-public (count-list lst) "Given lst (E1 E2 .. ) return ((E1 . 1) (E2 . 2) ... ) " + (define (helper l acc count) (if (pair? l) (helper (cdr l) (cons (cons (car l) count) acc) (1+ count)) @@ -293,19 +278,17 @@ found." "Return list of elements in A that are not in B." (lset-difference eq? a b)) -;; TODO: use the srfi-1 partition function. (define-public (uniq-list lst) - "Uniq LST, assuming that it is sorted" - (define (helper acc lst) - (if (null? lst) - acc - (if (null? (cdr lst)) - (cons (car lst) acc) - (if (equal? (car lst) (cadr lst)) - (helper acc (cdr lst)) - (helper (cons (car lst) acc) (cdr lst)))))) - (reverse! (helper '() lst) '())) + + (reverse! + (fold (lambda (x acc) + (if (null? acc) + (list x) + (if (eq? x (car acc)) + acc + (cons x acc)))) + '() lst) '())) (define (split-at-predicate predicate lst) "Split LST = (a_1 a_2 ... a_k b_1 ... b_k) @@ -314,6 +297,7 @@ found." L1 is copied, L2 not. (split-at-predicate (lambda (x y) (= (- y x) 2)) '(1 3 5 9 11) (cons '() '()))" + ;; " Emacs is broken (define (inner-split predicate lst acc) @@ -396,6 +380,9 @@ found." (define-public interval-end cdr) +(define-public (interval-bound interval dir) + ((if (= dir RIGHT) cdr car) interval)) + (define-public (interval-index interval dir) "Interpolate INTERVAL between between left (DIR=-1) and right (DIR=+1)" @@ -439,9 +426,16 @@ found." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; - - +;; string + +(define-public (string-endswith s suffix) + (equal? suffix (substring s + (max 0 (- (string-length s) (string-length suffix))) + (string-length s)))) + +(define-public (string-startswith s prefix) + (equal? prefix (substring s 0 (min (string-length s) (string-length prefix))))) + (define-public (string-encode-integer i) (cond ((= i 0) "o") @@ -532,6 +526,12 @@ possibly turned off." 0 (if (< x 0) -1 1))) +(define-public (round2 num) + (/ (round (* 100 num)) 100)) + +(define-public (round4 num) + (/ (round (* 10000 num)) 10000)) + (define-public (car< a b) (< (car a) (car b))) (define-public (symbol