scm/pdftex.scm

   1 ;;; pdftex.scm -- implement Scheme output routines for PDFTeX
   2 ;;;
   3 ;;;  source file of the GNU LilyPond music typesetter
   4 ;;;  modified from the existing tex.scm
   5 ;;;
   6 ;;; (c) 1998--2001 Jan Nieuwenhuizen <janneke@gnu.org>
   7 ;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
   8 ;;; Stephen Peters <portnoy@portnoy.org>
   9
  10
  11 ;; TODO: port this  to the new module framework.
  12
  13 (define-module (scm pdftex))
  14
  15 (define (unknown)
  16   "%\n\\unknown%\n")
  17
  18
  19 (define (select-font name-mag-pair)
  20   (let*
  21       (
  22        (c (assoc name-mag-pair font-name-alist))
  23        )
  24
  25     (if (eq? c #f)
  26         (begin
  27           (display "FAILED\n")
  28           (display (object-type (car name-mag-pair)))
  29           (display (object-type (caaar font-name-alist)))
  30
  31           (ly-warn (string-append
  32                     "Programming error: No such font known "
  33                     (car name-mag-pair) " "
  34                     (ly-number->string (cdr name-mag-pair))
  35                     ))
  36           "") ; issue no command
  37         (string-append "\\" (cddr c)))
  38
  39
  40     ))
  41
  42 (define (beam width slope thick)
  43   (embedded-pdf ((pdf-scm 'beam) width slope thick)))
  44
  45 (define (bracket arch_angle arch_width arch_height height arch_thick thick)
  46   (embedded-pdf ((pdf-scm 'bracket) arch_angle arch_width arch_height height arch_thick thick)))
  47
  48 (define (dashed-slur thick dash l)
  49   (embedded-pdf ((pdf-scm 'dashed-slur)  thick dash l)))
  50
  51 (define (char i)
  52   (string-append "\\char" (inexact->string i 10) " "))
  53
  54 (define (dashed-line thick on off dx dy)
  55   (embedded-pdf ((pdf-scm 'dashed-line) thick on off dx dy)))
  56
  57 (define (font-load-command name-mag command)
  58   (string-append
  59    "\\font\\" command "="
  60    (car name-mag)
  61    " scaled "
  62    (ly-number->string (inexact->exact (* 1000  (cdr name-mag))))
  63    "\n"))
  64
  65 (define (ez-ball c l b)
  66   (embedded-pdf ((pdf-scm 'ez-ball) c  l b)))
  67
  68 (define (embedded-pdf s)
  69   (string-append "\\embeddedpdf{ " s "}"))
  70
  71 (define (comment s)
  72   (string-append "% " s))
  73
  74 (define (end-output)
  75   (begin
  76                                         ; uncomment for some stats about lily memory
  77                                         ;               (display (gc-stats))
  78     (string-append "\n\\EndLilyPondOutput"
  79                                         ; Put GC stats here.
  80                    )))
  81
  82 (define (experimental-on)
  83   "")
  84
  85 (define (repeat-slash w a t)
  86   (embedded-pdf ((pdf-scm 'repeat-slash) w a t)))
  87
  88 (define (font-switch i)
  89   (string-append
  90    "\\" (font i) "\n"))
  91
  92 (define (font-def i s)
  93   (string-append
  94    "\\font" (font-switch i) "=" s "\n"))
  95
  96 (define (header-end)
  97   (string-append
  98    "\\input lilyponddefs\\newdimen\\outputscale \\outputscale=\\lilypondpaperoutputscale pt"
  99    "\\turnOnPostScript"
 100    "\\pdfcompresslevel=0"))
 101
 102 ;; Note: this string must match the string in ly2dvi.py!!!
 103 (define (header creator generate)
 104   (string-append
 105    "% Generated automatically by: " creator generate "\n"))
 106
 107 (define (invoke-char s i)
 108   (string-append
 109    "\n\\" s "{" (inexact->string i 10) "}" ))
 110
 111 ;;
 112 ;; need to do something to make this really safe.
 113 ;;
 114 (define (output-tex-string s)
 115   (if security-paranoia
 116       (if use-regex
 117           (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
 118           (begin (display "warning: not paranoid") (newline) s))
 119       s))
 120
 121 (define (lily-def key val)
 122   (let ((tex-key
 123          (if use-regex
 124              (regexp-substitute/global
 125               #f "_" (output-tex-string key) 'pre "X" 'post)
 126              (output-tex-string key)))
 127         (tex-val (output-tex-string val)))
 128     (if (equal? (sans-surrounding-whitespace tex-val) "")
 129         (string-append "\\let\\" tex-key "\\undefined\n")
 130         (string-append "\\def\\" tex-key "{" tex-val "}\n"))))
 131
 132 (define (number->dim x)
 133   (string-append
 134    ;;ugh ly-* in backend needs compatibility func for standalone output
 135    (ly-number->string x) " \\outputscale "))
 136
 137 (define (placebox x y s)
 138   (string-append
 139    "\\placebox{"
 140    (number->dim y) "}{" (number->dim x) "}{" s "}\n"))
 141
 142 (define (bezier-sandwich l thick)
 143   (embedded-pdf ((pdf-scm 'bezier-sandwich) l thick)))
 144
 145 (define (start-system ht)
 146   (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n"))
 147
 148 (define (stop-system)
 149   "}\\vss}\\interscoreline\n")
 150 (define (stop-last-system)
 151   "}\\vss}")
 152 (define (filledbox breapth width depth height)
 153   (string-append
 154    "\\kern" (number->dim (- breapth))
 155    "\\vrule width " (number->dim (+ breapth width))
 156    "depth " (number->dim depth)
 157    "height " (number->dim height) " "))
 158
 159 (define (roundfilledbox x width y height blotdiam)
 160   (embedded-pdf ((pdf-scm 'roundfilledbox) x width y height blotdiam)))
 161
 162 (define (text s)
 163   (string-append "\\hbox{" (output-tex-string s) "}"))
 164
 165
 166 (define (define-origin file line col)
 167   (if (procedure? point-and-click)
 168       (string-append "\\special{src:\\string:"
 169                      (point-and-click line col file)
 170                      "}" )
 171       "")
 172   )
 173
 174                                         ; no-origin not supported in PDFTeX
 175 (define (no-origin) "")
 176
 177
 178 (define (scm-pdftex-output)
 179   (primitive-eval (pdftex-scm 'all-definitions)))