init/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 ; TODO
   8 ;   - naming
   9 ;   - ready ps code (draw_bracket) vs tex/ps macros/calls (pianobrace),
  10 ;     all preparations from ps,tex to scm
  11
  12 ;;; library funtions
  13 (define
  14   (numbers->string l)
  15   (apply string-append
  16   (map (lambda (n) (string-append (number->string n) " ")) l)))
  17
  18 (define (chop-decimal x) (if (< (abs x) 0.001) 0.0 x))
  19
  20 (define (number->octal-string x)
  21   (let* ((n (inexact->exact x))
  22          (n64 (quotient n 64))
  23          (n8 (quotient (- n (* n64 64)) 8)))
  24         (string-append
  25          (number->string n64)
  26          (number->string n8)
  27          (number->string (remainder (- n (+ (* n64 64) (* n8 8))) 8)))))
  28
  29 (define (inexact->string x radix)
  30   (let ((n (inexact->exact x)))
  31        (number->string n radix)))
  32
  33 (define
  34   (number->dim-tex x)
  35   (string-append
  36    (number->string (chop-decimal x)) "pt "))
  37
  38 (define
  39   (control->string c)
  40   (string-append
  41     (string-append (number->string (car c)) " ")
  42     (string-append (number->string (cadr c)) " ")))
  43
  44 (define
  45   (embedded-ps-tex s)
  46   (string-append "\\embeddedps{" s "}"))
  47
  48 (define
  49   (invoke-char-ps s i)
  50   (string-append
  51    "(\\" (inexact->string i 8) ") " s " " ))
  52
  53 (define
  54   (invoke-char-tex s i)
  55   (string-append
  56    "\n\\" s "{" (inexact->string i 10) "}" ))
  57
  58 (define
  59   (invoke-dim1-ps s d)
  60   (string-append
  61    (number->string d) " " s ))
  62
  63 (define
  64   (invoke-dim1-tex s d)
  65   (string-append
  66    "\n\\" s "{" (number->dim-tex d) "}"))
  67
  68 (define
  69   (invoke-output o s)
  70    (eval-string (string-append s "-" o)))
  71
  72 ;;; output definitions
  73
  74 (define
  75   (beam o width slope thick)
  76   ((invoke-output o "beam") width slope thick))
  77
  78 (define
  79   (beam-ps width slope thick)
  80   (string-append
  81    (numbers->string (list width slope thick)) " draw_beam " ))
  82
  83 (define
  84   (beam-tex width slope thick)
  85   (embedded-ps-tex (beam-ps width slope thick)))
  86
  87 (define
  88   (bracket o h)
  89   ((invoke-output o "bracket") h))
  90
  91 (define
  92   (bracket-ps h)
  93   (invoke-dim1-ps "draw_bracket" h))
  94
  95 (define
  96   (bracket-tex h)
  97   (embedded-ps-tex (bracket-ps h)))
  98
  99 (define
 100   (char o n)
 101   ((invoke-output o "invoke-char") "show" n))
 102
 103 (define
 104   (dashed-slur o thick dash l)
 105   ((invoke-output o "dashed-slur") thick dash l))
 106
 107 (define
 108   (dashed-slur-ps thick dash l)
 109   (string-append
 110     (apply string-append (map control->string l))
 111     (number->string thick)
 112    " [ "
 113    (if (> 1 dash) (number->string (- (* thick dash) thick)) "0") " "
 114    (number->string (* 2 thick))
 115    " ] 0 draw_dashed_slur"))
 116
 117 (define
 118   (dashed-slur-tex thick dash l)
 119   (embedded-ps-tex (dashed-slur-ps thick dash l)))
 120
 121 (define
 122   (doublebar o h)
 123   ((invoke-output o "invoke-dim1") "doublebar" h))
 124
 125 (define
 126   (empty o)
 127   ((invoke-output o "empty")))
 128
 129 (define
 130   (empty-ps)
 131   "\n empty\n")
 132
 133 (define
 134   (empty-tex)
 135   "%\n\\empty%\n")
 136
 137 (define
 138   (emptybar o h) (empty o))
 139
 140 (define
 141   (end-output o)
 142   ((invoke-output o "end-output")))
 143
 144 (define
 145   (end-output-ps)
 146   "\nshowpage\n")
 147
 148 (define
 149   (end-output-tex)
 150   "\n\\EndLilyPondOutput")
 151
 152 (define
 153   (experimental-on o)
 154   ((invoke-output o "experimental-on")))
 155
 156 (define
 157   (experimental-on-ps) "")
 158
 159 (define
 160   (experimental-on-tex) "\\turnOnExperimentalFeatures")
 161
 162 (define
 163   (fatdoublebar o h)
 164   ((invoke-output o "invoke-dim1") "fatdoublebar" h))
 165
 166 (define
 167   (finishbar o h)
 168   ((invoke-output o "invoke-dim1") "finishbar" h))
 169
 170 (define
 171   (font i)
 172   (string-append
 173    "font"
 174    (make-string 1 (integer->char (+ (char->integer #\A) i)))
 175    ))
 176
 177 (define
 178   (font-def o i s)
 179   ((invoke-output o "font-def") i s))
 180
 181 (define
 182   (font-def-ps i s)
 183   (string-append
 184    "\n/" (font i) " {/"
 185    (substring s 0 (- (string-length s) 4))
 186    " findfont 12 scalefont setfont} bind def\n"))
 187
 188 (define
 189   (font-def-tex i s)
 190   (string-append
 191    "\\font" (font-switch-tex i) "=" s "\n"))
 192
 193 (define
 194   (font-switch o i)
 195   ((invoke-output o "font-switch") i))
 196
 197 (define
 198   (font-switch-ps i)
 199   (string-append (font i) " "))
 200
 201 (define
 202   (font-switch-tex i)
 203   (string-append
 204    "\\" (font i) "\n"))
 205
 206 (define
 207   (generalmeter o num den)
 208    ((invoke-output o "generalmeter") num den))
 209
 210 (define
 211   (generalmeter-ps num den)
 212   (string-append (number->string (inexact->exact num)) " " (number->string (inexact->exact den)) " generalmeter "))
 213
 214 (define
 215   (generalmeter-tex num den)
 216   (string-append
 217    "\\generalmeter{" (number->string (inexact->exact num)) "}{" (number->string (inexact->exact den)) "}"))
 218
 219 (define
 220   (header o creator generate)
 221   ((invoke-output o "header") creator generate))
 222
 223 (define
 224   (header-ps creator generate)
 225   (string-append
 226    "%!PS-Adobe-3.0\n"
 227    "%%Creator: " creator generate "\n"))
 228
 229 (define
 230   (header-tex creator generate)
 231   (string-append
 232    "%created by: " creator generate "\n"))
 233
 234 (define
 235   (header-end o)
 236   ((invoke-output o "header-end")))
 237
 238 (define
 239   (header-end-ps) "")
 240
 241 (define
 242   (header-end-tex) "\\turnOnPostScript")
 243
 244 (define
 245   (lily-def o key val)
 246   ((invoke-output o "lily-def") key val))
 247
 248 (define
 249   (lily-def-ps key val)
 250   (string-append
 251    "/" key " {" val "} bind def\n"))
 252
 253 (define
 254   (lily-def-tex key val)
 255   (string-append
 256    "\\def\\" key "{" val "}\n"))
 257
 258 (define
 259   (maatstreep o h)
 260   ((invoke-output o "invoke-dim1") "maatstreep" h))
 261
 262 (define
 263   (pianobrace o i)
 264   ((invoke-output o "invoke-char") "pianobrace" i))
 265
 266 (define
 267   (placebox o x y b)
 268   ((invoke-output o "placebox") x y (b o)))
 269
 270 (define
 271   (placebox-ps x y s)
 272   (string-append
 273    (number->string x) " " (number->string y) " {" s "} placebox "))
 274
 275 (define
 276   (placebox-tex x y s)
 277   (string-append
 278    "\\placebox{"
 279    (number->dim-tex y) "}{" (number->dim-tex x) "}{" s "}"))
 280
 281 (define
 282   (repeatbar o h)
 283   ((invoke-output o "invoke-dim1") "repeatbar" h))
 284
 285 (define
 286   (repeatbarstartrepeat o h)
 287   ((invoke-output o "invoke-dim1") "repeatbarstartrepeat" h))
 288
 289 (define
 290   (rulesym o x y)
 291   ((invoke-output o "rulesym") x y))
 292
 293 (define
 294   (rulesym-ps x y)
 295   (string-append
 296    (number->string x) " "
 297    (number->string y) " "
 298    "rulesym"))
 299
 300 (define
 301   (rulesym-tex x y)
 302   (string-append
 303    "\\rulesym{" (number->dim-tex x) "}{" (number->dim-tex y) "}"))
 304
 305 (define
 306   (setbold o s)
 307   ((invoke-output o "text") "bold" s))
 308
 309 (define
 310   (setdynamic o s) (empty o))
 311
 312 (define
 313   (setfinger o s)
 314   ((invoke-output o "text") "finger" s))
 315
 316 (define
 317   (sethuge o s)
 318   ((invoke-output o "text") "huge" s))
 319
 320 (define
 321   (setitalic o s)
 322   ((invoke-output o "text") "italic" s))
 323
 324 (define
 325   (setlarge o s)
 326   ((invoke-output o "text") "large" s))
 327
 328 (define
 329   (setLarge o s)
 330   ((invoke-output o "text") "Large" s))
 331
 332 (define
 333   (setnumber o s)
 334   ((invoke-output o "text") "number" s))
 335
 336 (define
 337   (settext o s)
 338   ((invoke-output o "text") "text" s))
 339
 340 (define
 341   (settypewriter o s)
 342   ((invoke-output o "text") "typewriter" s))
 343
 344 (define
 345   (slur o l)
 346   ((invoke-output o "slur") l))
 347
 348 (define
 349   (slur-ps l)
 350   (string-append
 351    (apply string-append (map control->string l))
 352    " draw_slur"))
 353
 354 (define
 355   (slur-tex l)
 356   (embedded-ps-tex (slur-ps l)))
 357
 358 (define
 359   (stem o kern width height depth)
 360   ((invoke-output o "stem") kern width height depth))
 361
 362 (define
 363   (stem-ps kern width height depth)
 364   (string-append (numbers->string (list kern width height depth))
 365                  "draw_stem" ))
 366
 367 (define
 368   (stem-tex kern width height depth)
 369   (string-append
 370    "\\kern" (number->dim-tex kern)
 371    "\\vrule width " (number->dim-tex width)
 372    "depth " (number->dim-tex depth)
 373    "height " (number->dim-tex height) " "))
 374
 375 (define
 376   (start-line o)
 377   ((invoke-output o "start-line")))
 378
 379 (define
 380   (start-line-ps)
 381    "\nstart_line {\n")
 382
 383 (define
 384   (start-line-tex)
 385    "\\hbox{%\n")
 386
 387 (define
 388   (startrepeat o h)
 389   ((invoke-output o "invoke-dim1") "startrepeat" h))
 390
 391 (define
 392   (stop-line o)
 393   ((invoke-output o "stop-line")))
 394
 395 (define
 396   (stop-line-ps)
 397   "}\nstop_line\n")
 398
 399 (define
 400   (stop-line-tex)
 401   "}\\interscoreline")
 402
 403 (define
 404   (stoprepeat o h)
 405   ((invoke-output o "invoke-dim1") "stoprepeat" h))
 406
 407 (define
 408   (text-ps f s)
 409   (string-append "(" s ") set" f " "))
 410
 411 (define
 412   (text-tex f s)
 413   (string-append "\\set" f "{" s "}"))
 414
 415