scm/output-tex.scm

   1 ;;;; tex.scm -- implement Scheme output routines for TeX
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c)  1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
   6 ;;;;                  Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8
   9 ;; (debug-enable 'backtrace)
  10
  11 ;; the public interface is tight.
  12 ;; It has to be, because user-code is evalled with this module.
  13
  14 (define-module (scm output-tex)
  15   #:re-export (quote)
  16   #:export (font-command
  17              unknown
  18              blank
  19              dot
  20              beam
  21              bracket
  22              dashed-slur
  23              char
  24              dashed-line
  25              zigzag-line
  26              symmetric-x-triangle
  27              ez-ball
  28              comment
  29              repeat-slash
  30              placebox
  31              bezier-sandwich
  32              horizontal-line
  33              filledbox
  34              round-filled-box
  35              text
  36              tuplet
  37              polygon
  38              draw-line
  39              define-origin
  40              no-origin
  41              ))
  42
  43 (use-modules (ice-9 regex)
  44              (ice-9 string-fun)
  45              (ice-9 format)
  46              (guile)
  47              (srfi srfi-13)
  48              (lily))
  49
  50 ;;;;;;;;
  51 ;;;;;;;; DOCUMENT ME!
  52 ;;;;;;;;
  53
  54
  55 (define (font-command font)
  56   (string-append
  57    "magfont"
  58    (string-encode-integer
  59     (hashq (ly:font-filename font) 1000000))
  60    "m"
  61    (string-encode-integer
  62     (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
  63
  64
  65 (define (unknown)
  66   "%\n\\unknown\n")
  67
  68 (define-public (symbol->tex-key sym)
  69   (regexp-substitute/global
  70    #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post) )
  71
  72 (define (string->param string)
  73   (string-append "{" string "}"))
  74
  75 (define (number->param number)
  76   (string->param (ly:number->string number)))
  77
  78 (define (number-pair->param o)
  79   (string-append (number->param (car o)) (number->param (cdr o))))
  80
  81 (define-public (tex-number-def prefix key number)
  82   (string-append
  83    "\\def\\" prefix (symbol->tex-key key) (string->param number) "%\n"))
  84
  85
  86 (define (blank)
  87   "")
  88
  89 (define (dot x y radius)
  90   (embedded-ps (list 'dot x y radius)))
  91
  92 (define (beam width slope thick blot)
  93   (embedded-ps (list 'beam  width slope thick blot)))
  94
  95 (define (bracket arch_angle arch_width arch_height height arch_thick thick)
  96   (embedded-ps (list 'bracket  arch_angle arch_width arch_height height arch_thick thick)))
  97
  98 (define (dashed-slur thick dash l)
  99   (embedded-ps (list 'dashed-slur thick dash `(quote ,l))))
 100
 101 (define (char font i)
 102   (string-append "\\" (font-command font)
 103                  "\\char" (ly:inexact->string i 10) " "))
 104
 105 (define (dashed-line thick on off dx dy)
 106   (embedded-ps (list 'dashed-line  thick on off dx dy)))
 107
 108 (define (zigzag-line centre? zzw zzh thick dx dy)
 109   (embedded-ps (list 'zigzag-line centre? zzw zzh thick dx dy)))
 110
 111 (define (symmetric-x-triangle t w h)
 112   (embedded-ps (list 'symmetric-x-triangle t w h)))
 113
 114 (define-public (font-load-command bookpaper font)
 115   (string-append
 116    "\\font\\" (font-command font) "="
 117    (ly:font-filename font)
 118    " scaled "
 119    (ly:number->string (inexact->exact
 120                        (round (* 1000
 121                           (ly:font-magnification font)
 122                           (ly:bookpaper-outputscale bookpaper)))))
 123    "\n"))
 124
 125 (define (ez-ball c l b)
 126   (embedded-ps (list 'ez-ball  c  l b)))
 127
 128
 129
 130 (define (embedded-ps expr)
 131   (let ((ps-string
 132          (with-output-to-string
 133            (lambda () (ps-output-expression expr (current-output-port))))))
 134     (string-append "\\embeddedps{" ps-string "}")))
 135
 136 (define (comment s)
 137   (string-append "% " s "\n"))
 138
 139 (define (end-output)
 140   (begin
 141     ;; uncomment for some stats about lily memory
 142     ;; (display (gc-stats))
 143     (string-append
 144      "\\lilypondend\n"
 145      ;; Put GC stats here.
 146      )))
 147
 148 (define (repeat-slash w a t)
 149   (embedded-ps (list 'repeat-slash  w a t)))
 150
 151
 152 (define-public (sanitize-tex-string s) ;; todo: rename
 153    (if (ly:get-option 'safe)
 154       (regexp-substitute/global #f "\\\\"
 155                                 (regexp-substitute/global #f "([{}])" "bla{}" 'pre  "\\" 1 'post )
 156                                 'pre "$\\backslash$" 'post)
 157
 158       s))
 159
 160 (define (lily-def key val)
 161   (let ((tex-key
 162          (regexp-substitute/global
 163               #f "_" (sanitize-tex-string key) 'pre "X" 'post))
 164
 165         (tex-val (sanitize-tex-string val)))
 166     (if (equal? (sans-surrounding-whitespace tex-val) "")
 167         (string-append "\\let\\" tex-key "\\undefined\n")
 168         (string-append "\\def\\" tex-key "{" tex-val "}%\n"))))
 169
 170 (define (number->dim x)
 171   (string-append
 172    ;;ugh ly:* in backend needs compatibility func for standalone output
 173    (ly:number->string x) " \\outputscale "))
 174
 175 (define (placebox x y s)
 176   (string-append
 177    "\\lyitem" (number->param x) (number->param y) (string->param s) "%\n"))
 178
 179 (define (bezier-sandwich l thick)
 180   (embedded-ps (list 'bezier-sandwich  `(quote ,l) thick)))
 181
 182 ;; WTF is this in every backend?
 183 (define (horizontal-line x1 x2 th)
 184   (filledbox (- x1) (- x2 x1) (* .5 th) (* .5 th)))
 185
 186 (define (filledbox breapth width depth height)
 187   (if (and #f (defined? 'ps-testing))
 188       (embedded-ps
 189        (string-append (ly:numbers->string (list breapth width depth height))
 190                       " draw_box" ))
 191       (string-append "\\lyvrule{"
 192                      (ly:number->string (- breapth)) "}{"
 193                      (ly:number->string (+ breapth width)) "}{"
 194                      (ly:number->string depth) "}{"
 195                      (ly:number->string height) "}")))
 196
 197 (define (round-filled-box x y width height blotdiam)
 198   (embedded-ps (list 'round-filled-box  x y width height blotdiam)))
 199
 200 (define (text font s)
 201   (let*
 202       ((mapping #f)       ;; (assoc-get  'char-mapping (ly:font-encoding-alist font))))
 203
 204
 205        ;; TODO: we'd better do this for PS only
 206        ;; LaTeX gets in the way, and we need to remap
 207        ;; nonprintable chars.
 208
 209        (input-enc-name #f) ;; (assoc-get 'input-name (ly:font-encoding-alist font) ))
 210        )
 211
 212     (string-append "\\hbox{\\" (font-command font)
 213                    (if (string? input-enc-name)
 214                        (string-append "\\inputencoding{" input-enc-name "}")
 215                        "{}")
 216                    (sanitize-tex-string
 217                     (if (vector? mapping)
 218                         (reencode-string mapping s)
 219                         s))
 220                    "}")))
 221
 222
 223 (define (tuplet ht gapx dx dy thick dir)
 224   (embedded-ps (list 'tuplet  ht gapx dx dy thick dir)))
 225
 226 (define (polygon points blotdiameter)
 227   (embedded-ps (list 'polygon `(quote ,points) blotdiameter)))
 228
 229 (define (draw-line thick fx fy tx ty)
 230   (embedded-ps (list 'draw-line thick fx fy tx ty)))
 231
 232 (define (define-origin file line col)
 233   (if (procedure? point-and-click)
 234       (string-append "\\special{src:" ;;; \\string ?
 235                      (point-and-click line col file)
 236                      "}" )
 237       ""))
 238
 239 ;; no-origin not yet supported by Xdvi
 240 (define (no-origin) "")
 241