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 Jan Nieuwenhuizen <janneke@gnu.org>
   6
   7 ;
   8 ; This file contains various routines in Scheme that are easier to
   9 ; do here than in C++.  At present it is an unorganised mess. Sorry.
  10 ;
  11
  12 ; We should repartition the entire scm side of lily in a
  13 ; more sane way, using namesspaces/modules?
  14
  15 (debug-enable 'backtrace)
  16
  17 ;;; library funtions
  18
  19 (use-modules (ice-9 regex))
  20
  21 (define (number-pair?  x)
  22   (and (pair? x) (number? (car x)) (number? (cdr x))))
  23
  24 (define (object-type obj)
  25   (cond
  26    ((dir? obj) "direction")
  27    ((number-pair? obj) "pair of numbers")
  28    ((ly-input-location? obj) "input location")
  29    ((ly-element? obj) "graphic element")
  30    ((pair? obj) "pair")
  31    ((integer? obj) "integer")
  32    ((list? obj) "list")
  33    ((symbol? obj) "symbol")
  34    ((string? obj) "string")
  35    ((boolean? obj) "boolean")
  36    ((moment? obj) "moment")
  37    ((number? obj) "number")
  38    ((char? obj) "char")
  39    ((input-port? obj) "input port")
  40    ((output-port? obj) "output port")
  41    ((vector? obj) "vector")
  42    ((procedure? obj) "procedure")
  43    (else "unknown type")
  44   ))
  45
  46
  47 (define (type-name  predicate)
  48   (cond
  49    ((eq? predicate dir?) "direction")
  50    ((eq? predicate number-pair?) "pair of numbers")
  51    ((eq? predicate ly-input-location?) "input location")
  52    ((eq? predicate ly-element?) "graphic element")
  53    ((eq? predicate pair?) "pair")
  54    ((eq? predicate integer?) "integer")
  55    ((eq? predicate list?) "list")
  56    ((eq? predicate symbol?) "symbol")
  57    ((eq? predicate string?) "string")
  58    ((eq? predicate boolean?) "boolean")
  59    ((eq? predicate moment?) "moment")
  60    ((eq? predicate number?) "number")
  61    ((eq? predicate char?) "char")
  62    ((eq? predicate input-port?) "input port")
  63    ((eq? predicate output-port?) "output port")
  64    ((eq? predicate vector?) "vector")
  65    ((eq? predicate procedure?) "procedure")
  66    (else "unknown type")
  67   ))
  68
  69
  70 ;; The regex module may not be available, or may be broken.
  71 (define use-regex
  72   (let ((os (string-downcase (vector-ref (uname) 0))))
  73     (not (equal? "cygwin" (substring os 0 (min 6 (string-length os)))))))
  74
  75 ;; If you have trouble with regex, define #f
  76 (define use-regex #t)
  77 ;;(define use-regex #f)
  78
  79 ;; do nothing in .scm output
  80 (define (comment s) "")
  81
  82 ;; URG guile-1.3/1.4 compatibility
  83 (define (ly-eval x) (eval2 x #f))
  84
  85 (define (comment s) "")
  86
  87 (define (mm-to-pt x)
  88   (* (/ 72.27 25.40) x)
  89   )
  90
  91 (define (cons-map f x)
  92   (cons (f (car x)) (f (cdr x))))
  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
 101 (define (numbers->string l)
 102   (apply string-append (map ly-number->string l)))
 103
 104 ; (define (chop-decimal x) (if (< (abs x) 0.001) 0.0 x))
 105
 106 (define (number->octal-string x)
 107   (let* ((n (inexact->exact x))
 108          (n64 (quotient n 64))
 109          (n8 (quotient (- n (* n64 64)) 8)))
 110     (string-append
 111      (number->string n64)
 112      (number->string n8)
 113      (number->string (remainder (- n (+ (* n64 64) (* n8 8))) 8)))))
 114
 115 (define (inexact->string x radix)
 116   (let ((n (inexact->exact x)))
 117     (number->string n radix)))
 118
 119
 120 (define (control->string c)
 121   (string-append (number->string (car c)) " "
 122                  (number->string (cdr c)) " "))
 123
 124 (define (font i)
 125   (string-append
 126    "font"
 127    (make-string 1 (integer->char (+ (char->integer #\A) i)))
 128    ))
 129
 130 (define (scm-scm action-name)
 131   1)
 132
 133 (define security-paranoia #f)
 134
 135
 136 ;; silly, use alist?
 137 (define (find-notehead-symbol duration style)
 138   (case style
 139    ((cross) "2cross")
 140    ((harmonic) "0mensural")
 141    ((baroque)
 142     (string-append (number->string duration)
 143                    (if (< duration 0) "mensural" "")))
 144    ((default) (number->string duration))
 145    (else
 146     (string-append (number->string duration) (symbol->string style))))
 147   )
 148
 149
 150 ;;;;;;;; TeX
 151
 152 (define (string-encode-integer i)
 153   (cond
 154    ((= i  0) "o")
 155    ((< i 0)   (string-append "n" (string-encode-integer (- i))))
 156    (else (string-append
 157           (make-string 1 (integer->char (+ 65 (modulo i 26))))
 158           (string-encode-integer (quotient i 26))
 159           ))
 160    )
 161   )
 162
 163 (define default-script-alist '())
 164
 165 (define font-name-alist  '())
 166 (define (tex-encoded-fontswitch name-mag)
 167   (let* (
 168          (iname-mag (car name-mag))
 169          (ename-mag (cdr name-mag))
 170          )
 171     (cons iname-mag
 172           (cons ename-mag
 173                 (string-append  "magfont"
 174                           (string-encode-integer
 175                            (hashq (car ename-mag) 1000000))
 176                           "m"
 177                           (string-encode-integer
 178                            (inexact->exact (* 1000 (cdr ename-mag))))
 179
 180                           )
 181                 )
 182     )))
 183
 184 (define (define-fonts internal-external-name-mag-pairs)
 185   (set! font-name-alist (map tex-encoded-fontswitch
 186                              internal-external-name-mag-pairs))
 187   (apply string-append
 188          (map (lambda (x)
 189                 (font-load-command (car x) (cdr x)))
 190               (map cdr font-name-alist)
 191
 192   )))
 193
 194 (define (fontify name-mag-pair exp)
 195   (string-append (select-font name-mag-pair)
 196                  exp)
 197   )
 198
 199 ;;;;;;;;;;;;;;;;;;;;
 200
 201
 202 ; Make a function that checks score element for being of a specific type.
 203 (define (make-type-checker symbol)
 204   (lambda (elt)
 205     ;;(display  symbol)
 206     ;;(eq? #t (ly-get-elt-property elt symbol))
 207     (not (eq? #f (memq symbol (ly-get-elt-property elt 'interfaces))))
 208     ))
 209
 210 ;;;;;;;;;;;;;;;;;;; TeX output
 211 (define (tex-scm action-name)
 212   (define (unknown)
 213     "%\n\\unknown%\n")
 214
 215
 216   (define (select-font name-mag-pair)
 217     (let*
 218         (
 219          (c (assoc name-mag-pair font-name-alist))
 220          )
 221
 222       (if (eq? c #f)
 223           (begin
 224             (display "FAILED\n")
 225             (display (object-type (car name-mag-pair)))
 226             (display (object-type (caaar font-name-alist)))
 227
 228             (ly-warn (string-append
 229                       "Programming error: No such font known "
 230                       (car name-mag-pair) " "
 231                       (number->string (cdr name-mag-pair))
 232                       ))
 233             "") ; issue no command
 234           (string-append "\\" (cddr c)))
 235
 236
 237       ))
 238
 239   (define (beam width slope thick)
 240     (embedded-ps ((ps-scm 'beam) width slope thick)))
 241
 242   (define (bracket arch_angle arch_width arch_height width height arch_thick thick)
 243     (embedded-ps ((ps-scm 'bracket) arch_angle arch_width arch_height width height arch_thick thick)))
 244
 245   (define (dashed-slur thick dash l)
 246     (embedded-ps ((ps-scm 'dashed-slur)  thick dash l)))
 247
 248   (define (crescendo thick w h cont)
 249     (embedded-ps ((ps-scm 'crescendo) thick w h cont)))
 250
 251   (define (char i)
 252     (string-append "\\char" (inexact->string i 10) " "))
 253
 254   (define (dashed-line thick on off dx dy)
 255     (embedded-ps ((ps-scm 'dashed-line) thick on off dx dy)))
 256
 257   (define (decrescendo thick w h cont)
 258     (embedded-ps ((ps-scm 'decrescendo) thick w h cont)))
 259
 260   (define (font-load-command name-mag command)
 261     (string-append
 262      "\\font\\" command "="
 263      (car name-mag)
 264      " scaled "
 265      (number->string (inexact->exact (* 1000  (cdr name-mag))))
 266      "\n"))
 267
 268   (define (embedded-ps s)
 269     (string-append "\\embeddedps{" s "}"))
 270
 271   (define (comment s)
 272     (string-append "% " s))
 273
 274   (define (end-output)
 275         (begin
 276 ; uncomment for some stats about lily memory
 277 ;               (display (gc-stats))
 278     (string-append "\n\\EndLilyPondOutput"
 279                    ; Put GC stats here.
 280                    )))
 281
 282   (define (experimental-on)
 283     "")
 284
 285   (define (font-switch i)
 286     (string-append
 287      "\\" (font i) "\n"))
 288
 289   (define (font-def i s)
 290     (string-append
 291      "\\font" (font-switch i) "=" s "\n"))
 292
 293   (define (header-end)
 294     (string-append
 295      "\\special{! "
 296
 297      ;; URG: ly-gulp-file: now we can't use scm output without Lily
 298      (if use-regex
 299          ;; fixed in 1.3.4 for powerpc -- broken on Windows
 300          (regexp-substitute/global #f "\n"
 301                                    (ly-gulp-file "lily.ps") 'pre " %\n" 'post)
 302          (ly-gulp-file "lily.ps"))
 303      "}"
 304      "\\input lilyponddefs\\newdimen\\outputscale \\outputscale=\\mudelapaperoutputscale pt\\turnOnPostScript"))
 305
 306   (define (header creator generate)
 307     (string-append
 308      "%created by: " creator generate "\n"))
 309
 310   (define (invoke-char s i)
 311     (string-append
 312      "\n\\" s "{" (inexact->string i 10) "}" ))
 313
 314   (define (invoke-dim1 s d)
 315     (string-append
 316      "\n\\" s "{" (number->dim d) "}"))
 317   (define (pt->sp x)
 318     (* 65536 x))
 319
 320   ;;
 321   ;; need to do something to make this really safe.
 322   ;;
 323   (define (output-tex-string s)
 324       (if security-paranoia
 325           (if use-regex
 326               (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
 327               (begin (display "warning: not paranoid") (newline) s))
 328           s))
 329
 330   (define (lily-def key val)
 331     (string-append
 332      "\\def\\"
 333      (if use-regex
 334          ;; fixed in 1.3.4 for powerpc -- broken on Windows
 335          (regexp-substitute/global #f "_"
 336                                    (output-tex-string key) 'pre "X" 'post)
 337          (output-tex-string key))
 338      "{" (output-tex-string val) "}\n"))
 339
 340   (define (number->dim x)
 341     (string-append
 342      (ly-number->string x) " \\outputscale "))
 343
 344   (define (placebox x y s)
 345     (string-append
 346      "\\placebox{"
 347      (number->dim y) "}{" (number->dim x) "}{" s "}\n"))
 348
 349   (define (bezier-sandwich l thick)
 350     (embedded-ps ((ps-scm 'bezier-sandwich) l thick)))
 351
 352   (define (start-line ht)
 353       (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n"))
 354
 355   (define (stop-line)
 356     "}\\vss}\\interscoreline\n")
 357   (define (stop-last-line)
 358     "}\\vss}")
 359   (define (filledbox breapth width depth height)
 360     (string-append
 361      "\\kern" (number->dim (- breapth))
 362      "\\vrule width " (number->dim (+ breapth width))
 363      "depth " (number->dim depth)
 364      "height " (number->dim height) " "))
 365
 366   (define (text s)
 367     (string-append "\\hbox{" (output-tex-string s) "}"))
 368
 369   (define (tuplet ht gapx dx dy thick dir)
 370     (embedded-ps ((ps-scm 'tuplet) ht gapx dx dy thick dir)))
 371
 372   (define (volta h w thick vert_start vert_end)
 373     (embedded-ps ((ps-scm 'volta) h w thick vert_start vert_end)))
 374
 375   (define (define-origin file line col)
 376     ; use this for column positions
 377      (string-append "\\special{src:" (number->string line) ":"
 378         (number->string col) " " file "}"
 379          ;; arg, the clueless take over the mailing list...
 380 ;        "\\special{-****-These-warnings-are-harmless-***}"
 381 ;        "\\special{-****-PLEASE-read-http://appel.lilypond.org/wiki/index.php3?PostProcessing-****}"
 382         )
 383
 384      ; line numbers only:
 385     ;(string-append "\\special{src:" (number->string line) " " file "}")
 386 )
 387     ; no origin  info: return empty string
 388     ; ""
 389   ; no-origin not yet supported by Xdvi
 390   (define (no-origin) "")
 391
 392   ;; TeX
 393   ;; The procedures listed below form the public interface of TeX-scm.
 394   ;; (should merge the 2 lists)
 395   (cond ((eq? action-name 'all-definitions)
 396          `(begin
 397             (define font-load-command ,font-load-command)
 398             (define beam ,beam)
 399             (define bezier-sandwich ,bezier-sandwich)
 400             (define bracket ,bracket)
 401             (define char ,char)
 402             (define crescendo ,crescendo)
 403             (define dashed-line ,dashed-line)
 404             (define dashed-slur ,dashed-slur)
 405             (define decrescendo ,decrescendo)
 406             (define end-output ,end-output)
 407             (define experimental-on ,experimental-on)
 408             (define filledbox ,filledbox)
 409             (define font-def ,font-def)
 410             (define font-switch ,font-switch)
 411             (define header-end ,header-end)
 412             (define lily-def ,lily-def)
 413             (define header ,header)
 414             (define invoke-char ,invoke-char)
 415             (define invoke-dim1 ,invoke-dim1)
 416             (define placebox ,placebox)
 417             (define select-font ,select-font)
 418             (define start-line ,start-line)
 419             (define stop-line ,stop-line)
 420             (define stop-last-line ,stop-last-line)
 421             (define text ,text)
 422             (define tuplet ,tuplet)
 423             (define volta ,volta)
 424             (define define-origin ,define-origin)
 425             (define no-origin ,no-origin)
 426             ))
 427
 428         ((eq? action-name 'beam) beam)
 429         ((eq? action-name 'tuplet) tuplet)
 430         ((eq? action-name 'bracket) bracket)
 431         ((eq? action-name 'crescendo) crescendo)
 432         ((eq? action-name 'dashed-line) dashed-line)
 433         ((eq? action-name 'dashed-slur) dashed-slur)
 434         ((eq? action-name 'decrescendo) decrescendo)
 435         ((eq? action-name 'end-output) end-output)
 436         ((eq? action-name 'experimental-on) experimental-on)
 437         ((eq? action-name 'font-def) font-def)
 438         ((eq? action-name 'font-switch) font-switch)
 439         ((eq? action-name 'header-end) header-end)
 440         ((eq? action-name 'lily-def) lily-def)
 441         ((eq? action-name 'header) header)
 442         ((eq? action-name 'invoke-char) invoke-char)
 443         ((eq? action-name 'invoke-dim1) invoke-dim1)
 444         ((eq? action-name 'placebox) placebox)
 445         ((eq? action-name 'bezier-sandwich) bezier-sandwich)
 446         ((eq? action-name 'start-line) start-line)
 447         ((eq? action-name 'stem) stem)
 448         ((eq? action-name 'stop-line) stop-line)
 449         ((eq? action-name 'stop-last-line) stop-last-line)
 450         ((eq? action-name 'volta) volta)
 451         (else (error "unknown tag -- PS-TEX " action-name))
 452         )
 453   )
 454
 455
 456 ;;;;;;;;;;;; PS
 457 (define (ps-scm action-name)
 458
 459   ;; alist containing fontname -> fontcommand assoc (both strings)
 460   (define font-alist '())
 461   (define font-count 0)
 462   (define current-font "")
 463
 464
 465   (define (cached-fontname i)
 466     (string-append
 467      "lilyfont"
 468      (make-string 1 (integer->char (+ 65 i)))))
 469
 470
 471   (define (select-font name-mag-pair)
 472     (let*
 473         (
 474          (c (assoc name-mag-pair font-name-alist))
 475          )
 476
 477       (if (eq? c #f)
 478           (begin
 479             (display name-mag-pair)
 480             (display font-name-alist)
 481             (ly-warn (string-append
 482                       "Programming error: No such font known " (car name-mag-pair))
 483                      (number->string (cdr name-mag-pair))
 484                      )
 485
 486             "")                         ; issue no command
 487           (string-append " " (cdr c) " "))
 488       ))
 489
 490     (define (font-load-command name-mag command)
 491       (string-append
 492        "/" command
 493        " { /"
 494        (symbol->string (car name-mag))
 495        " findfont "
 496        (number->string (cdr name-mag))
 497        " 1000 div 12 mul  scalefont setfont } bind def "
 498        "\n"))
 499
 500
 501   (define (beam width slope thick)
 502     (string-append
 503      (numbers->string (list width slope thick)) " draw_beam" ))
 504
 505   (define (comment s)
 506     (string-append "% " s))
 507
 508   (define (bracket arch_angle arch_width arch_height width height arch_thick thick)
 509     (string-append
 510      (numbers->string (list arch_angle arch_width arch_height width height arch_thick thick)) " draw_bracket" ))
 511
 512   (define (char i)
 513     (invoke-char " show" i))
 514
 515   (define (crescendo thick w h cont )
 516     (string-append
 517      (numbers->string (list w h (inexact->exact cont) thick))
 518      " draw_crescendo"))
 519
 520   ;; what the heck is this interface ?
 521   (define (dashed-slur thick dash l)
 522     (string-append
 523      (apply string-append (map control->string l))
 524      (number->string thick)
 525      " [ "
 526      (number->string dash)
 527      " "
 528      (number->string (* 10 thick))      ;UGH.  10 ?
 529      " ] 0 draw_dashed_slur"))
 530
 531   (define (dashed-line thick on off dx dy)
 532     (string-append
 533      (number->string dx)
 534      " "
 535      (number->string dy)
 536      " "
 537      (number->string thick)
 538      " [ "
 539      (number->string on)
 540      " "
 541      (number->string off)
 542      " ] 0 draw_dashed_line"))
 543
 544   (define (decrescendo thick w h cont)
 545     (string-append
 546      (numbers->string (list w h (inexact->exact cont) thick))
 547      " draw_decrescendo"))
 548
 549
 550   (define (end-output)
 551     "\nshowpage\n")
 552
 553   (define (experimental-on) "")
 554
 555   (define (filledbox breapth width depth height)
 556     (string-append (numbers->string (list breapth width depth height))
 557                    " draw_box" ))
 558
 559   ;; obsolete?
 560   (define (font-def i s)
 561     (string-append
 562      "\n/" (font i) " {/"
 563      (substring s 0 (- (string-length s) 4))
 564      " findfont 12 scalefont setfont} bind def \n"))
 565
 566   (define (font-switch i)
 567     (string-append (font i) " "))
 568
 569   (define (header-end)
 570     (string-append
 571      ;; URG: now we can't use scm output without Lily
 572      (ly-gulp-file "lilyponddefs.ps")
 573      " {exch pop //systemdict /run get exec} "
 574      (ly-gulp-file "lily.ps")
 575      "{ exch pop //systemdict /run get exec } "
 576     ))
 577
 578   (define (lily-def key val)
 579
 580      (if (string=? (substring key 0 (min (string-length "mudelapaper") (string-length key))) "mudelapaper")
 581          (string-append "/" key " {" val "} bind def\n")
 582          (string-append "/" key " (" val ") def\n")
 583          )
 584      )
 585
 586   (define (header creator generate)
 587     (string-append
 588      "%!PS-Adobe-3.0\n"
 589      "%%Creator: " creator generate "\n"))
 590
 591   (define (invoke-char s i)
 592     (string-append
 593      "(\\" (inexact->string i 8) ") " s " " ))
 594
 595   (define (invoke-dim1 s d)
 596     (string-append
 597      (number->string (* d  (/ 72.27 72))) " " s ))
 598
 599   (define (placebox x y s)
 600     (string-append
 601      (number->string x) " " (number->string y) " {" s "} placebox "))
 602
 603   (define (bezier-sandwich l thick)
 604     (string-append
 605      (apply string-append (map control->string l))
 606      (number->string  thick)
 607      " draw_bezier_sandwich"))
 608
 609   (define (start-line height)
 610           "\nstart_line {\n")
 611
 612   (define (stem breapth width depth height)
 613     (string-append (numbers->string (list breapth width depth height))
 614                    " draw_box" ))
 615
 616   (define (stop-line)
 617       "}\nstop_line\n")
 618
 619   (define (text s)
 620     (string-append "(" s ") show  "))
 621
 622
 623   (define (volta h w thick vert_start vert_end)
 624     (string-append
 625      (numbers->string (list h w thick (inexact->exact vert_start) (inexact->exact vert_end)))
 626      " draw_volta"))
 627
 628   (define (tuplet ht gap dx dy thick dir)
 629     (string-append
 630      (numbers->string (list ht gap dx dy thick (inexact->exact dir)))
 631      " draw_tuplet"))
 632
 633
 634   (define (unknown)
 635     "\n unknown\n")
 636
 637
 638   (define (define-origin a b c ) "")
 639   (define (no-origin) "")
 640
 641   ;; PS
 642   (cond ((eq? action-name 'all-definitions)
 643          `(begin
 644             (define beam ,beam)
 645             (define tuplet ,tuplet)
 646             (define bracket ,bracket)
 647             (define char ,char)
 648             (define crescendo ,crescendo)
 649             (define volta ,volta)
 650             (define bezier-sandwich ,bezier-sandwich)
 651             (define dashed-line ,dashed-line)
 652             (define dashed-slur ,dashed-slur)
 653             (define decrescendo ,decrescendo)
 654             (define end-output ,end-output)
 655             (define experimental-on ,experimental-on)
 656             (define filledbox ,filledbox)
 657             (define font-def ,font-def)
 658             (define font-switch ,font-switch)
 659             (define header-end ,header-end)
 660             (define lily-def ,lily-def)
 661             (define font-load-command ,font-load-command)
 662             (define header ,header)
 663             (define invoke-char ,invoke-char)
 664             (define invoke-dim1 ,invoke-dim1)
 665             (define placebox ,placebox)
 666             (define select-font ,select-font)
 667             (define start-line ,start-line)
 668             (define stem ,stem)
 669             (define stop-line ,stop-line)
 670             (define stop-last-line ,stop-line)
 671             (define text ,text)
 672             (define no-origin ,no-origin)
 673             (define define-origin ,define-origin)
 674             ))
 675         ((eq? action-name 'tuplet) tuplet)
 676         ((eq? action-name 'beam) beam)
 677         ((eq? action-name 'bezier-sandwich) bezier-sandwich)
 678         ((eq? action-name 'bracket) bracket)
 679         ((eq? action-name 'char) char)
 680         ((eq? action-name 'crescendo) crescendo)
 681         ((eq? action-name 'dashed-line) dashed-line)
 682         ((eq? action-name 'dashed-slur) dashed-slur)
 683         ((eq? action-name 'decrescendo) decrescendo)
 684         ((eq? action-name 'experimental-on) experimental-on)
 685         ((eq? action-name 'filledbox) filledbox)
 686         ((eq? action-name 'select-font) select-font)
 687         ((eq? action-name 'volta) volta)
 688         (else (error "unknown tag -- PS-SCM " action-name))
 689         )
 690   )
 691
 692
 693 (define (arg->string arg)
 694   (cond ((number? arg) (inexact->string arg 10))
 695         ((string? arg) (string-append "\"" arg "\""))
 696         ((symbol? arg) (string-append "\"" (symbol->string arg) "\""))))
 697
 698 ; ugh: naming.
 699 (define (func name . args)
 700   (string-append
 701    "(" name
 702    (if (null? args)
 703        ""
 704        (apply string-append
 705               (map (lambda (x) (string-append " " (arg->string x))) args)))
 706    ")\n"))
 707
 708 (define (sign x)
 709   (if (= x 0)
 710       1
 711       (if (< x 0) -1 1)))
 712
 713 (define (gulp-file name)
 714   (let* ((port (open-file name "r"))
 715          (content (let loop ((text ""))
 716                        (let ((line (read-line port)))
 717                             (if (or (eof-object? line)
 718                                     (not line))
 719                                 text
 720                                 (loop (string-append text line "\n")))))))
 721         (close port)
 722         content))
 723
 724 ;; urg: Use when standalone, do:
 725 ;; (define ly-gulp-file scm-gulp-file)
 726 (define (scm-gulp-file name)
 727   (set! %load-path
 728         (cons (string-append (getenv 'LILYPONDPREFIX) "/ly")
 729               (cons (string-append (getenv 'LILYPONDPREFIX) "/ps")
 730                     %load-path)))
 731   (let ((path (%search-load-path name)))
 732        (if path
 733            (gulp-file path)
 734            (gulp-file name))))
 735
 736 (define (scm-tex-output)
 737   (ly-eval (tex-scm 'all-definitions)))
 738
 739 (define (scm-ps-output)
 740   (ly-eval (ps-scm 'all-definitions)))
 741
 742 (define (scm-as-output)
 743   (ly-eval (as-scm 'all-definitions)))
 744
 745 (define (index-cell cell dir)
 746   (if (equal? dir 1)
 747       (cdr cell)
 748       (car cell)))
 749
 750 (define major-scale
 751   '(
 752     (0 . 0)
 753     (1 . 0)
 754     (2 . 0)
 755     (3 . 0)
 756     (4 . 0)
 757     (5 . 0)
 758     (6 . 0)
 759     )
 760   )
 761
 762 (begin
 763   (eval-string (ly-gulp-file "interface.scm"))
 764   (eval-string (ly-gulp-file "slur.scm"))
 765   (eval-string (ly-gulp-file "font.scm"))
 766   (eval-string (ly-gulp-file "generic-property.scm"))
 767   (eval-string (ly-gulp-file "basic-properties.scm"))
 768   (eval-string (ly-gulp-file "chord-names.scm"))
 769   (eval-string (ly-gulp-file "element-descriptions.scm"))
 770  )