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--2000 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) (number? (car x)) (number? (cdr x))))
  12
  13 (define (boolean-or-symbol? x) (or boolean? x) (or symbol? x))
  14
  15 (define (number-or-string? x) (or (number? x) (string? x)))
  16
  17 (define markup?
  18   (lambda (x) (or (string? x) (list? x))))
  19
  20 ;; ugh: code dup ; merge.
  21 (define (object-type obj)
  22   (cond
  23    ((dir? obj) "direction")
  24    ((number-pair? obj) "pair of numbers")
  25    ((ly-input-location? obj) "input location")
  26    ((ly-grob? obj) "grob (GRaphical OBject)")
  27    ((pair? obj) "pair")
  28    ((integer? obj) "integer")
  29    ((list? obj) "list")
  30    ((symbol? obj) "symbol")
  31    ((string? obj) "string")
  32    ((boolean? obj) "boolean")
  33    ((moment? obj) "moment")
  34    ((number? obj) "number")
  35    ((char? obj) "char")
  36    ((input-port? obj) "input port")
  37    ((output-port? obj) "output port")
  38    ((vector? obj) "vector")
  39    ((procedure? obj) "procedure")
  40    ((boolean-or-symbol? obj) "boolean or symbol")
  41    ((number-or-string? obj) "number or string")
  42    ((markup? obj) "markup (list or string)")
  43    (else "unknown type")))
  44
  45
  46 (define (type-name  predicate)
  47   (cond
  48    ((eq? predicate dir?) "direction")
  49    ((eq? predicate number-pair?) "pair of numbers")
  50    ((eq? predicate ly-input-location?) "input location")
  51    ((eq? predicate ly-grob?) "Grob")
  52    ((eq? predicate pair?) "pair")
  53    ((eq? predicate integer?) "integer")
  54    ((eq? predicate list?) "list")
  55    ((eq? predicate symbol?) "symbol")
  56    ((eq? predicate string?) "string")
  57    ((eq? predicate boolean?) "boolean")
  58    ((eq? predicate moment?) "moment")
  59    ((eq? predicate number?) "number")
  60    ((eq? predicate char?) "char")
  61    ((eq? predicate input-port?) "input port")
  62    ((eq? predicate output-port?) "output port")
  63    ((eq? predicate vector?) "vector")
  64    ((eq? predicate procedure?) "procedure")
  65    ((eq? predicate boolean-or-symbol?) "boolean or symbol")
  66    ((eq? predicate number-or-string?) "number or string")
  67    ((eq? predicate markup?) "markup (list or string)")
  68    (else "unknown type")))
  69
  70
  71 (define (uniqued-alist  alist acc)
  72   (if (null? alist) acc
  73       (if (assoc (caar alist) acc)
  74           (uniqued-alist (cdr alist) acc)
  75           (uniqued-alist (cdr alist) (cons (car alist) acc)))))
  76
  77
  78
  79 ;;(define (cons-map f x)
  80 ;;  (cons (f (car x)) (f (cdr x))))
  81
  82
  83 ;;(define (reduce operator list)
  84 ;;      (if (null? (cdr list)) (car list)
  85 ;;        (operator (car list) (reduce operator (cdr list)))))
  86
  87
  88
  89 ; Make a function that checks score element for being of a specific type.
  90 (define (make-type-checker symbol)
  91   (lambda (elt)
  92     ;;(display  symbol)
  93     ;;(eq? #t (ly-get-elt-property elt symbol))
  94     (not (eq? #f (memq symbol (ly-get-elt-property elt 'interfaces))))))
  95
  96
  97 (define (index-cell cell dir)
  98   (if (equal? dir 1)
  99       (cdr cell)
 100       (car cell)))
 101
 102 (define (repeat-name-to-ctor name)
 103   (let*
 104       ((supported-reps
 105         `(("volta" . ((iterator-ctor . ,Volta_repeat_iterator::constructor)
 106                       (length . ,Repeated_music::volta_music_length)))
 107             ("unfold" . ((iterator-ctor . ,Unfolded_repeat_iterator::constructor)
 108                        (length . ,Repeated_music::unfolded_music_length)))
 109             ("fold" . ((iterator-ctor  . ,Folded_repeat_iterator::constructor)
 110                        (length . ,Repeated_music::folded_music_length)))
 111             ("tremolo" . ((iterator-ctor . ,Chord_tremolo_iterator::constructor)
 112                           (length . ,Repeated_music::unfolded_music_length)))))
 113
 114        (handle (assoc name supported-reps)))
 115
 116     (if (pair? handle)
 117         (cdr handle)
 118         (begin
 119           (ly-warn
 120            (string-append "Unknown repeat type `" name "'\nSee scm/lily.scm for supported repeats"))
 121           '(type . 'repeated-music)))))