From: Han-Wen Nienhuys Date: Sat, 12 Jun 2004 19:21:28 +0000 (+0000) Subject: don't load output-XXX from framework-XXX X-Git-Tag: release/2.3.4~19 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=03147447d5826e0f909150bd7720d88a06661be7;p=lilypond.git don't load output-XXX from framework-XXX --- diff --git a/ChangeLog b/ChangeLog index 484dd03031..a1a649e501 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2004-06-12 Han-Wen Nienhuys + + * scm/framework-ps.scm: don't load output-XXX from framework-XXX + 2004-06-12 Jan Nieuwenhuizen * scm/output-gnome.scm: Update script. Move development to diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index eb62b853fd..4b708ac28c 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -12,9 +12,35 @@ (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")) diff --git a/scm/framework-tex.scm b/scm/framework-tex.scm index 23a64ee2e8..f2989d3400 100644 --- a/scm/framework-tex.scm +++ b/scm/framework-tex.scm @@ -4,16 +4,54 @@ ;;;; ;;;; (c) 2004 Han-Wen Nienhuys -(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 @@ -28,7 +66,7 @@ (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))) diff --git a/scm/output-ps.scm b/scm/output-ps.scm index ba9cdef0a2..3057f513a7 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -58,6 +58,7 @@ (ice-9 regex) (srfi srfi-1) (srfi srfi-13) + (scm framework-ps) (lily)) ;;; helper functions, not part of output interface @@ -140,32 +141,7 @@ ; 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) "") diff --git a/scm/output-tex.scm b/scm/output-tex.scm index 7ca908aac1..6a0cebe77e 100644 --- a/scm/output-tex.scm +++ b/scm/output-tex.scm @@ -13,8 +13,7 @@ (define-module (scm output-tex) #:re-export (quote) - #:export (font-command - unknown + #:export (unknown blank dot beam @@ -45,6 +44,7 @@ (ice-9 format) (guile) (srfi srfi-13) + (scm framework-tex) (lily)) ;;;;;;;; @@ -52,35 +52,10 @@ ;;;;;;;; -(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) @@ -99,7 +74,7 @@ (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) @@ -111,16 +86,6 @@ (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))) @@ -149,23 +114,6 @@ (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 @@ -174,7 +122,7 @@ (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))) @@ -209,7 +157,7 @@ (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 "}") "{}")