X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fc%2B%2B.scm;h=8db8bb96c079185d54da0b887180e0545a094227;hb=794dcbdb52faf4292036cd1b0270a956cf4316a3;hp=045002d357763db785d8be5876ff510c90644be1;hpb=31a43e122332d7a8e703ff5f01286eacc4ea7a27;p=lilypond.git diff --git a/scm/c++.scm b/scm/c++.scm index 045002d357..8db8bb96c0 100644 --- a/scm/c++.scm +++ b/scm/c++.scm @@ -1,134 +1,62 @@ ;;;; c++.scm -- implement Scheme frontends to C++ functions ;;;; ;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 1998--2001 Jan Nieuwenhuizen -;;;; Han-Wen Nienhuys +;;;; +;;;; (c) 1998--2009 Jan Nieuwenhuizen +;;;; Han-Wen Nienhuys ;;; Note: this file can't be used without LilyPond executable -(define (number-pair? x) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; type predicates. +(define-public (number-pair? x) (and (pair? x) (number? (car x)) (number? (cdr x)))) -(define (moment-pair? x) +(define-public (number-or-grob? x) + (or (ly:grob? x) (number? x))) + +(define-public (grob-list? x) + (list? x)) + +(define-public (moment-pair? x) (and (pair? x) - (moment? (car x)) (moment? (cdr x)))) + (ly:moment? (car x)) (ly:moment? (cdr x)))) -(define (boolean-or-symbol? x) +(define-public (boolean-or-symbol? x) (or (boolean? x) (symbol? x))) -(define (number-or-boolean? x) - (or (number? x) (boolean? x))) +(define-public (string-or-symbol? x) + (or (string? x) (symbol? x))) -(define (number-or-string? x) +(define-public (number-or-string? x) (or (number? x) (string? x))) -(define (markup? x) - (or (string? x) (list? x))) - -;; ugh: code dup ; merge. -(define (object-type obj) - (cond - ((dir? obj) "direction") - ((number-pair? obj) "pair of numbers") - ((ly-input-location? obj) "input location") - ((ly-grob? obj) "grob (GRaphical OBject)") - ((pair? obj) "pair") - ((integer? obj) "integer") - ((list? obj) "list") - ((symbol? obj) "symbol") - ((string? obj) "string") - ((boolean? obj) "boolean") - ((moment? obj) "moment") - ((number? obj) "number") - ((char? obj) "char") - ((input-port? obj) "input port") - ((output-port? obj) "output port") - ((vector? obj) "vector") - ((procedure? obj) "procedure") - ((boolean-or-symbol? obj) "boolean or symbol") - ((number-or-string? obj) "number or string") - ((number-or-boolean? obj) "number or boolean") - ((markup? obj) "markup (list or string)") - (else "unknown type"))) - - -(define (type-name predicate) - (cond - ((eq? predicate dir?) "direction") - ((eq? predicate number-pair?) "pair of numbers") - ((eq? predicate ly-input-location?) "input location") - ((eq? predicate ly-grob?) "Grob") - ((eq? predicate pair?) "pair") - ((eq? predicate integer?) "integer") - ((eq? predicate list?) "list") - ((eq? predicate symbol?) "symbol") - ((eq? predicate string?) "string") - ((eq? predicate boolean?) "boolean") - ((eq? predicate moment?) "moment") - ((eq? predicate number?) "number") - ((eq? predicate char?) "char") - ((eq? predicate input-port?) "input port") - ((eq? predicate output-port?) "output port") - ((eq? predicate vector?) "vector") - ((eq? predicate procedure?) "procedure") - ((eq? predicate boolean-or-symbol?) "boolean or symbol") - ((eq? predicate number-or-string?) "number or string") - ((eq? predicate markup?) "markup (list or string)") - (else "unknown type"))) - - -(define (uniqued-alist alist acc) - (if (null? alist) acc - (if (assoc (caar alist) acc) - (uniqued-alist (cdr alist) acc) - (uniqued-alist (cdr alist) (cons (car alist) acc))))) - - - -;;(define (cons-map f x) -;; (cons (f (car x)) (f (cdr x)))) - - -;;(define (reduce operator list) -;; (if (null? (cdr list)) (car list) -;; (operator (car list) (reduce operator (cdr list))))) - - - -; Make a function that checks score element for being of a specific type. -(define (make-type-checker symbol) - (lambda (elt) - ;;(display symbol) - ;;(eq? #t (ly-get-grob-property elt symbol)) - (not (eq? #f (memq symbol (ly-get-grob-property elt 'interfaces)))))) - - -(define (index-cell cell dir) - (if (equal? dir 1) - (cdr cell) - (car cell))) - -(define (repeat-name-to-ctor name) - (let* - ((supported-reps - `(("volta" . ((iterator-ctor . ,Volta_repeat_iterator::constructor) - (length . ,Repeated_music::volta_music_length))) - ("unfold" . ((iterator-ctor . ,Unfolded_repeat_iterator::constructor) - (length . ,Repeated_music::unfolded_music_length))) - ("fold" . ((iterator-ctor . ,Folded_repeat_iterator::constructor) - (length . ,Repeated_music::folded_music_length))) - ("percent" . ((iterator-ctor . ,Percent_repeat_iterator::constructor) - (length . ,Repeated_music::unfolded_music_length))) - ("tremolo" . ((iterator-ctor . ,Chord_tremolo_iterator::constructor) - (length . ,Repeated_music::unfolded_music_length))))) - - (handle (assoc name supported-reps))) - - (if (pair? handle) - (cdr handle) - (begin - (ly-warn - (string-append "Unknown repeat type `" name "'\nSee scm/c++.scm for supported repeats")) - '(type . 'repeated-music))))) +(define-public (string-or-pair? x) + (or (string? x) (pair? x))) + +(define-public (scheme? x) #t) + + +;; moved list to end of lily.scm: then all type-predicates are +;; defined. +(define type-p-name-alist '()) + +(define (match-predicate obj alist) + (if (null? alist) + "Unknown type" + (if (apply (caar alist) obj) + (cdar alist) + (match-predicate obj (cdr alist))))) + +(define-public (object-type obj) + (match-predicate obj type-p-name-alist)) + +(define-public (object-type-name obj) + (type-name (match-predicate obj type-p-name-alist))) + +(define-public (type-name predicate) + (let ((entry (assoc predicate type-p-name-alist))) + (if (pair? entry) (cdr entry) + "unknown")))