scm/c++.scm

   1 ;;;; c++.scm -- implement Scheme frontends to C++ functions
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 1998--2001 Jan Nieuwenhuizen <janneke@gnu.org>
   6 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8 ;;; Note: this file can't be used without LilyPond executable
   9
  10 (define (number-pair?  x)
  11   (and (pair? x)
  12        (number? (car x)) (number? (cdr x))))
  13
  14 (define (moment-pair?  x)
  15   (and (pair? x)
  16        (moment? (car x)) (moment? (cdr x))))
  17
  18 (define (boolean-or-symbol? x)
  19   (or (boolean? x) (symbol? x)))
  20
  21 (define (number-or-boolean? x)
  22   (or (number? x) (boolean? x)))
  23
  24 (define (number-or-string? x)
  25   (or (number? x) (string? x)))
  26
  27 (define (markup? x)
  28   (or (string? x) (list? x)))
  29
  30 ;; ugh: code dup ; merge.
  31 (define (object-type obj)
  32   (cond
  33    ((dir? obj) "direction")
  34    ((number-pair? obj) "pair of numbers")
  35    ((ly-input-location? obj) "input location")
  36    ((ly-grob? obj) "grob (GRaphical OBject)")
  37    ((pair? obj) "pair")
  38    ((integer? obj) "integer")
  39    ((list? obj) "list")
  40    ((symbol? obj) "symbol")
  41    ((string? obj) "string")
  42    ((boolean? obj) "boolean")
  43    ((moment? obj) "moment")
  44    ((number? obj) "number")
  45    ((char? obj) "char")
  46    ((input-port? obj) "input port")
  47    ((output-port? obj) "output port")
  48    ((vector? obj) "vector")
  49    ((procedure? obj) "procedure")
  50    ((boolean-or-symbol? obj) "boolean or symbol")
  51    ((number-or-string? obj) "number or string")
  52    ((number-or-boolean? obj) "number or boolean")
  53    ((markup? obj) "markup (list or string)")
  54    (else "unknown type")))
  55
  56
  57 (define (type-name  predicate)
  58   (cond
  59    ((eq? predicate dir?) "direction")
  60    ((eq? predicate number-pair?) "pair of numbers")
  61    ((eq? predicate ly-input-location?) "input location")
  62    ((eq? predicate ly-grob?) "Grob")
  63    ((eq? predicate pair?) "pair")
  64    ((eq? predicate integer?) "integer")
  65    ((eq? predicate list?) "list")
  66    ((eq? predicate symbol?) "symbol")
  67    ((eq? predicate string?) "string")
  68    ((eq? predicate boolean?) "boolean")
  69    ((eq? predicate moment?) "moment")
  70    ((eq? predicate number?) "number")
  71    ((eq? predicate char?) "char")
  72    ((eq? predicate input-port?) "input port")
  73    ((eq? predicate output-port?) "output port")
  74    ((eq? predicate vector?) "vector")
  75    ((eq? predicate procedure?) "procedure")
  76    ((eq? predicate boolean-or-symbol?) "boolean or symbol")
  77    ((eq? predicate number-or-string?) "number or string")
  78    ((eq? predicate markup?) "markup (list or string)")
  79    (else "unknown type")))
  80
  81
  82 (define (uniqued-alist  alist acc)
  83   (if (null? alist) acc
  84       (if (assoc (caar alist) acc)
  85           (uniqued-alist (cdr alist) acc)
  86           (uniqued-alist (cdr alist) (cons (car alist) acc)))))
  87
  88
  89
  90 ;;(define (cons-map f x)
  91 ;;  (cons (f (car x)) (f (cdr x))))
  92
  93
  94 ;;(define (reduce operator list)
  95 ;;      (if (null? (cdr list)) (car list)
  96 ;;        (operator (car list) (reduce operator (cdr list)))))
  97
  98
  99
 100 ; Make a function that checks score element for being of a specific type.
 101 (define (make-type-checker symbol)
 102   (lambda (elt)
 103     ;;(display  symbol)
 104     ;;(eq? #t (ly-get-grob-property elt symbol))
 105     (not (eq? #f (memq symbol (ly-get-grob-property elt 'interfaces))))))
 106
 107
 108 (define (index-cell cell dir)
 109   (if (equal? dir 1)
 110       (cdr cell)
 111       (car cell)))
 112
 113 (define (repeat-name-to-ctor name)
 114   (let*
 115       ((supported-reps
 116         `(("volta" . ((iterator-ctor . ,Volta_repeat_iterator::constructor)
 117                       (length . ,Repeated_music::volta_music_length)))
 118             ("unfold" . ((iterator-ctor . ,Unfolded_repeat_iterator::constructor)
 119                        (length . ,Repeated_music::unfolded_music_length)))
 120             ("fold" . ((iterator-ctor  . ,Folded_repeat_iterator::constructor)
 121                        (length . ,Repeated_music::folded_music_length)))
 122             ("percent" . ((iterator-ctor . ,Percent_repeat_iterator::constructor)
 123                           (length . ,Repeated_music::unfolded_music_length)))
 124             ("tremolo" . ((iterator-ctor . ,Chord_tremolo_iterator::constructor)
 125                           (length . ,Repeated_music::unfolded_music_length)))))
 126
 127        (handle (assoc name supported-reps)))
 128
 129     (if (pair? handle)
 130         (cdr handle)
 131         (begin
 132           (ly-warn
 133            (string-append "Unknown repeat type `" name "'\nSee scm/c++.scm for supported repeats"))
 134           '(type . 'repeated-music)))))