+2004-06-12 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+ * scm/framework-ps.scm: don't load output-XXX from framework-XXX
+
2004-06-12 Jan Nieuwenhuizen <janneke@gnu.org>
* scm/output-gnome.scm: Update script. Move development to
(guile)
(srfi srfi-1)
(srfi srfi-13)
- (scm output-ps)
(lily))
+(define-public (ps-font-command font . override-coding)
+ (let* ((name (ly:font-filename font))
+ (magnify (ly:font-magnification font))
+ (coding-alist (ly:font-encoding-alist font))
+ (input-encoding (assoc-get 'input-name coding-alist))
+ (font-encoding (assoc-get 'output-name coding-alist))
+ (coding-command (if (null? override-coding)
+ (if (equal? input-encoding font-encoding)
+ #f font-encoding)
+ (car override-coding))))
+
+ ;; FIXME: now feta stuff has feta* input-encoding (again?)
+ ;;(format (current-error-port) "FONT: ~S, ~S\n" name font-encoding)
+ ;;(format (current-error-port) "INPUT: ~S\n" input-encoding)
+ (if (and coding-command
+ (or
+ (equal? (substring coding-command 0 4) "feta")
+ (equal? (substring coding-command 0 8) "parmesan")
+
+ ))
+ (set! coding-command #f))
+
+ (string-append
+ "magfont" (string-encode-integer (hashq name 1000000))
+ "m" (string-encode-integer (inexact->exact (round (* 1000 magnify))))
+ (if (not coding-command) "" (string-append "e" coding-command)))))
+
(define (tex-font? fontname)
(equal? (substring fontname 0 2) "cm"))
;;;;
;;;; (c) 2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
-(define-module (scm framework-tex))
+(define-module (scm framework-tex)
+ #:export (output-framework-tex
+ output-classic-framework-tex
+))
(use-modules (ice-9 regex)
(ice-9 string-fun)
(ice-9 format)
(guile)
(srfi srfi-13)
- (scm output-tex)
(lily))
+(define-public (sanitize-tex-string s) ;; todo: rename
+ (if (ly:get-option 'safe)
+ (regexp-substitute/global #f "\\\\"
+ (regexp-substitute/global #f "([{}])" "bla{}" 'pre "\\" 1 'post )
+ 'pre "$\\backslash$" 'post)
+
+ s))
+
+(define (symbol->tex-key sym)
+ (regexp-substitute/global
+ #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post) )
+
+(define (tex-number-def prefix key number)
+ (string-append
+ "\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
+
+(define-public (tex-font-command font)
+ (string-append
+ "magfont"
+ (string-encode-integer
+ (hashq (ly:font-filename font) 1000000))
+ "m"
+ (string-encode-integer
+ (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
+
+(define (font-load-command bookpaper font)
+ (string-append
+ "\\font\\" (tex-font-command font) "="
+ (ly:font-filename font)
+ " scaled "
+ (ly:number->string (inexact->exact
+ (round (* 1000
+ (ly:font-magnification font)
+ (ly:bookpaper-outputscale bookpaper)))))
+ "\n"))
+
(define (define-fonts bookpaper)
(string-append
(map (lambda (x) (font-load-command bookpaper x))
(ly:bookpaper-fonts bookpaper)))))
-(define-public (header-to-file fn key val)
+(define (header-to-file fn key val)
(set! key (symbol->string key))
(if (not (equal? "-" fn))
(set! fn (string-append fn "." key)))
(ice-9 regex)
(srfi srfi-1)
(srfi srfi-13)
+ (scm framework-ps)
(lily))
;;; helper functions, not part of output interface
; todo: merge with tex-font-command?
-(define-public (ps-font-command font . override-coding)
- (let* ((name (ly:font-filename font))
- (magnify (ly:font-magnification font))
- (coding-alist (ly:font-encoding-alist font))
- (input-encoding (assoc-get 'input-name coding-alist))
- (font-encoding (assoc-get 'output-name coding-alist))
- (coding-command (if (null? override-coding)
- (if (equal? input-encoding font-encoding)
- #f font-encoding)
- (car override-coding))))
-
- ;; FIXME: now feta stuff has feta* input-encoding (again?)
- ;;(format (current-error-port) "FONT: ~S, ~S\n" name font-encoding)
- ;;(format (current-error-port) "INPUT: ~S\n" input-encoding)
- (if (and coding-command
- (or
- (equal? (substring coding-command 0 4) "feta")
- (equal? (substring coding-command 0 8) "parmesan")
- ))
- (set! coding-command #f))
-
- (string-append
- "magfont" (string-encode-integer (hashq name 1000000))
- "m" (string-encode-integer (inexact->exact (round (* 1000 magnify))))
- (if (not coding-command) "" (string-append "e" coding-command)))))
(define (define-origin file line col) "")
(define-module (scm output-tex)
#:re-export (quote)
- #:export (font-command
- unknown
+ #:export (unknown
blank
dot
beam
(ice-9 format)
(guile)
(srfi srfi-13)
+ (scm framework-tex)
(lily))
;;;;;;;;
;;;;;;;;
-(define (font-command font)
- (string-append
- "magfont"
- (string-encode-integer
- (hashq (ly:font-filename font) 1000000))
- "m"
- (string-encode-integer
- (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
-
(define (unknown)
"%\n\\unknown\n")
-(define-public (symbol->tex-key sym)
- (regexp-substitute/global
- #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post) )
-
-(define (string->param string)
- (string-append "{" string "}"))
-
-(define (number->param number)
- (string->param (ly:number->string number)))
-
-(define (number-pair->param o)
- (string-append (number->param (car o)) (number->param (cdr o))))
-
-(define-public (tex-number-def prefix key number)
- (string-append
- "\\def\\" prefix (symbol->tex-key key) (string->param number) "%\n"))
(define (blank)
(embedded-ps (list 'dashed-slur thick dash `(quote ,l))))
(define (char font i)
- (string-append "\\" (font-command font)
+ (string-append "\\" (tex-font-command font)
"\\char" (ly:inexact->string i 10) " "))
(define (dashed-line thick on off dx dy)
(define (symmetric-x-triangle t w h)
(embedded-ps (list 'symmetric-x-triangle t w h)))
-(define-public (font-load-command bookpaper font)
- (string-append
- "\\font\\" (font-command font) "="
- (ly:font-filename font)
- " scaled "
- (ly:number->string (inexact->exact
- (round (* 1000
- (ly:font-magnification font)
- (ly:bookpaper-outputscale bookpaper)))))
- "\n"))
(define (ez-ball c l b)
(embedded-ps (list 'ez-ball c l b)))
(embedded-ps (list 'repeat-slash w a t)))
-(define-public (sanitize-tex-string s) ;; todo: rename
- (if (ly:get-option 'safe)
- (regexp-substitute/global #f "\\\\"
- (regexp-substitute/global #f "([{}])" "bla{}" 'pre "\\" 1 'post )
- 'pre "$\\backslash$" 'post)
-
- s))
-
-(define (lily-def key val)
- (let ((tex-key
- (regexp-substitute/global
- #f "_" (sanitize-tex-string key) 'pre "X" 'post))
-
- (tex-val (sanitize-tex-string val)))
- (if (equal? (sans-surrounding-whitespace tex-val) "")
- (string-append "\\let\\" tex-key "\\undefined\n")
- (string-append "\\def\\" tex-key "{" tex-val "}%\n"))))
(define (number->dim x)
(string-append
(define (placebox x y s)
(string-append
- "\\lyitem" (number->param x) (number->param y) (string->param s) "%\n"))
+ "\\lyitem{" (ly:number->string x) "}{" (ly:number->string y) "}{" s "}%\n"))
(define (bezier-sandwich l thick)
(embedded-ps (list 'bezier-sandwich `(quote ,l) thick)))
(input-enc-name #f) ;; (assoc-get 'input-name (ly:font-encoding-alist font) ))
)
- (string-append "\\hbox{\\" (font-command font)
+ (string-append "\\hbox{\\" (tex-font-command font)
(if (string? input-enc-name)
(string-append "\\inputencoding{" input-enc-name "}")
"{}")
projects / lilypond.git / commitdiff