scm/lily.scm

   1 ;;;; lily.scm -- implement Scheme output routines for TeX and PostScript
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 1998--2002 Jan Nieuwenhuizen <janneke@gnu.org>
   6 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8 ;;; Library functions
   9
  10
  11 (use-modules (ice-9 regex))
  12
  13
  14 ;;; General settings
  15 ;; debugging evaluator is slower.
  16
  17 (debug-enable 'debug)
  18 ;(debug-enable 'backtrace)
  19 (read-enable 'positions)
  20
  21
  22 (define-public (line-column-location line col file)
  23   "Print an input location, including column number ."
  24   (string-append (number->string line) ":"
  25                  (number->string col) " " file)
  26   )
  27
  28 (define-public (line-location line col file)
  29   "Print an input location, without column number ."
  30   (string-append (number->string line) " " file)
  31   )
  32
  33 (define-public point-and-click #f)
  34
  35 ;; cpp hack to get useful error message
  36 (define ifdef "First run this through cpp.")
  37 (define ifndef "First run this through cpp.")
  38
  39
  40
  41 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42
  43 (define-public X 0)
  44 (define-public Y 1)
  45 (define-public START -1)
  46 (define-public STOP 1)
  47 (define-public LEFT -1)
  48 (define-public RIGHT 1)
  49 (define-public UP 1)
  50 (define-public DOWN -1)
  51 (define-public CENTER 0)
  52
  53 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  54 ;; lily specific variables.
  55 (define-public default-script-alist '())
  56
  57 (define-public security-paranoia #f)
  58
  59 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  60 ;;; Unassorted utility functions.
  61
  62 (define (uniqued-alist  alist acc)
  63   (if (null? alist) acc
  64       (if (assoc (caar alist) acc)
  65           (uniqued-alist (cdr alist) acc)
  66           (uniqued-alist (cdr alist) (cons (car alist) acc)))))
  67
  68 (define (other-axis a)
  69   (remainder (+ a 1) 2))
  70
  71
  72 (define-public (widen-interval iv amount)
  73    (cons (- (car iv) amount)
  74          (+ (cdr iv) amount))
  75 )
  76
  77
  78
  79 (define (index-cell cell dir)
  80   (if (equal? dir 1)
  81       (cdr cell)
  82       (car cell)))
  83
  84 (define (cons-map f x)
  85   "map F to contents of X"
  86   (cons (f (car x)) (f (cdr x))))
  87
  88 ;; used where?
  89 (define-public (reduce operator list)
  90   "reduce OP [A, B, C, D, ... ] =
  91    A op (B op (C ... ))
  92 "
  93       (if (null? (cdr list)) (car list)
  94           (operator (car list) (reduce operator (cdr list)))))
  95
  96 (define (take-from-list-until todo gathered crit?)
  97   "return (G, T), where (reverse G) + T = GATHERED + TODO, and the last of G
  98 is the  first to satisfy CRIT
  99
 100  (take-from-list-until '(1 2 3  4 5) '() (lambda (x) (eq? x 3)))
 101 =>
 102  ((3 2 1) 4 5)
 103
 104 "
 105   (if (null? todo)
 106       (cons gathered todo)
 107       (if (crit? (car todo))
 108           (cons (cons (car todo) gathered) (cdr todo))
 109           (take-from-list-until (cdr todo) (cons (car todo) gathered) crit?)
 110       )
 111   ))
 112
 113
 114 (define-public (reduce-list list between)
 115   "Create new list, inserting BETWEEN between elements of LIST"
 116   (if (null? list)
 117       '()
 118       (if (null? (cdr list))
 119           list
 120           (cons (car list)
 121                 (cons between (reduce-list (cdr list) between)))
 122
 123   )))
 124
 125 (define-public (string-join str-list sep)
 126   "append the list of strings in STR-LIST, joining them with SEP"
 127   (apply string-append (reduce-list str-list sep))
 128   )
 129
 130
 131 (define (sign x)
 132   (if (= x 0)
 133       0
 134       (if (< x 0) -1 1)))
 135
 136 (define (write-me n x)
 137   (display n)
 138   (write x)
 139   (newline)
 140   x)
 141
 142 (define (!= l r)
 143   (not (= l r)))
 144
 145 (define-public (filter-list pred? list)
 146   "return that part of LIST for which PRED is true."
 147   (if (null? list) '()
 148       (let* ((rest  (filter-list pred? (cdr list))))
 149         (if (pred?  (car list))
 150             (cons (car list)  rest)
 151             rest))))
 152
 153 (define-public (filter-out-list pred? list)
 154   "return that part of LIST for which PRED is true."
 155   (if (null? list) '()
 156       (let* ((rest  (filter-list pred? (cdr list))))
 157         (if (not (pred?  (car list)))
 158             (cons (car list)  rest)
 159             rest))))
 160
 161 (define-public (uniqued-alist  alist acc)
 162   (if (null? alist) acc
 163       (if (assoc (caar alist) acc)
 164           (uniqued-alist (cdr alist) acc)
 165           (uniqued-alist (cdr alist) (cons (car alist) acc)))))
 166
 167 (define-public (uniq-list list)
 168   (if (null? list) '()
 169       (if (null? (cdr list))
 170           list
 171           (if (equal? (car list) (cadr list))
 172               (uniq-list (cdr list))
 173               (cons (car list) (uniq-list (cdr list)))))))
 174
 175 (define-public (alist<? x y)
 176   (string<? (symbol->string (car x))
 177             (symbol->string (car y))))
 178
 179 (define-public (pad-string-to str wid)
 180   (string-append str (make-string (max (- wid (string-length str)) 0) #\ ))
 181   )
 182
 183 (define-public (ly:load x)
 184   (let* (
 185          (fn (%search-load-path x))
 186
 187          )
 188     (if (ly:verbose)
 189         (format (current-error-port) "[~A]" fn))
 190     (primitive-load fn)))
 191
 192
 193 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 194 ;;  output
 195 (use-modules (scm tex)
 196              (scm ps)
 197              (scm pysk)
 198              (scm ascii-script)
 199              (scm sketch)
 200              (scm sodipodi)
 201              (scm pdftex)
 202              )
 203
 204 (define output-alist
 205   `(
 206     ("tex" . ("TeX output. The default output form." ,tex-output-expression))
 207     ("ps" . ("Direct postscript. Requires setting GS_LIB and GS_FONTPATH" ,ps-output-expression))
 208     ("scm" . ("Scheme dump: debug scheme molecule expressions" ,write))
 209     ("as" . ("Asci-script. Postprocess with as2txt to get ascii art"  ,as-output-expression))
 210     ("sketch" . ("Bare bones Sketch output." ,sketch-output-expression))
 211     ("sodipodi" . ("Bare bones Sodipodi output." ,sodipodi-output-expression))
 212     ("pdftex" . ("PDFTeX output. Was last seen nonfunctioning." ,pdftex-output-expression))
 213     ))
 214
 215
 216 (define (document-format-dumpers)
 217   (map
 218    (lambda (x)
 219      (display (string-append  (pad-string-to 5 (car x)) (cadr x) "\n"))
 220      output-alist)
 221    ))
 222
 223 (define-public (find-dumper format )
 224   (let*
 225       ((d (assoc format output-alist)))
 226
 227     (if (pair? d)
 228         (caddr d)
 229         (scm-error "Could not find dumper for format ~s" format))
 230     ))
 231
 232 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 233 ;; other files.
 234
 235 (map ly:load
 236                                         ; load-from-path
 237      '("music-types.scm"
 238        "output-lib.scm"
 239        "c++.scm"
 240
 241        "molecule.scm"
 242        "bass-figure.scm"
 243        "grob-property-description.scm"
 244        "context-description.scm"
 245        "interface-description.scm"
 246        "beam.scm"
 247        "clef.scm"
 248        "slur.scm"
 249        "font.scm"
 250        "music-functions.scm"
 251        "music-property-description.scm"
 252        "auto-beam.scm"
 253        "new-markup.scm"
 254        "basic-properties.scm"
 255        "chord-name.scm"
 256        "grob-description.scm"
 257        "translator-property-description.scm"
 258        "script.scm"
 259        "drums.scm"
 260        "midi.scm"
 261        ))
 262
 263
 264
 265
 266
 267 (set! type-p-name-alist
 268   `(
 269    (,ly:dir? . "direction")
 270    (,scheme? . "any type")
 271    (,number-pair? . "pair of numbers")
 272    (,ly:input-location? . "input location")
 273    (,ly:grob? . "grob (GRaphical OBject)")
 274    (,grob-list? . "list of grobs")
 275    (,ly:duration? . "duration")
 276    (,pair? . "pair")
 277    (,integer? . "integer")
 278    (,list? . "list")
 279    (,symbol? . "symbol")
 280    (,string? . "string")
 281    (,boolean? . "boolean")
 282    (,ly:moment? . "moment")
 283    (,ly:input-location? . "input location")
 284    (,music-list? . "list of music")
 285    (,ly:music? . "music")
 286    (,number? . "number")
 287    (,char? . "char")
 288    (,input-port? . "input port")
 289    (,output-port? . "output port")
 290    (,vector? . "vector")
 291    (,procedure? . "procedure")
 292    (,boolean-or-symbol? . "boolean or symbol")
 293    (,number-or-string? . "number or string")
 294    (,markup? . "markup")
 295    (,markup-list? . "list of markups")
 296    (,number-or-grob? . "number or grob")
 297    ))