From: Jan Nieuwenhuizen Date: Fri, 11 Oct 2002 14:02:26 +0000 (+0000) Subject: * buildscripts/mf-to-table.py: Add EncodingScheme. X-Git-Tag: release/1.7.3~9 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=fc500407b5f8a512a305ab52515d249fde3f36bc;p=lilypond.git * buildscripts/mf-to-table.py: Add EncodingScheme. * scm/sketch.scm: Resurrect. --- diff --git a/ChangeLog b/ChangeLog index ef724a04c6..bb798919fe 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2002-10-11 Jan Nieuwenhuizen + + * buildscripts/mf-to-table.py: Add EncodingScheme. + + * scm/sketch.scm: Resurrect. + 2002-10-11 Han-Wen Nienhuys * lily/multi-measure-rest.cc: use breve rests for measure lengths diff --git a/buildscripts/mf-to-table.py b/buildscripts/mf-to-table.py index d8aa7275d9..4d325a4e33 100644 --- a/buildscripts/mf-to-table.py +++ b/buildscripts/mf-to-table.py @@ -85,6 +85,7 @@ def parse_logfile (fn): global_info['FontBBox'] = '0 0 1000 1000' global_info['Ascender'] = '0' global_info['Descender'] = '0' + global_info['EncodingScheme'] = 'FontSpecific' return (global_info, charmetrics, deps) @@ -114,7 +115,7 @@ Comment Automatically generated by mf-to-table.py for m in charmetrics: write_afm_char_metric (file,m) file.write ('EndCharMetrics\n') - file.write ('EndFontMetrics %d\n') + file.write ('EndFontMetrics\n') def write_tex_defs (file, global_info, charmetrics): diff --git a/scm/sketch.scm b/scm/sketch.scm index f4b6762ddc..98705a319b 100644 --- a/scm/sketch.scm +++ b/scm/sketch.scm @@ -7,7 +7,9 @@ ;;; Han-Wen Nienhuys -;; als in: +;;; TODO: +;;; * rewrite +;;; * move y-translate systems ;; def dispats (out,x,y,expr): ;; (symbol, rest) = expr @@ -36,15 +38,6 @@ ;; NAME X Y ARGUMENTS-PASSED-BY-LILYPOND ;; -;; guile <= 1.4.x compatibility for eval -(if (or (equal? (minor-version) "4.1") - (equal? (minor-version) "4") - (equal? (minor-version) "3.4")) - (define (ly-eval e m) - (eval-in-module e m)) - (define (ly-eval e m) - (eval e m))) - (define-module (scm sketch)) (debug-enable 'backtrace) @@ -53,10 +46,7 @@ (define-public (sketch-output-expression expr port) (display (dispatch expr) port)) -(use-modules - (guile)) - -(use-modules (ice-9 format)) +(use-modules (ice-9 format) (guile) (lily)) (define (dispatch expr) @@ -65,10 +55,10 @@ ((eq? keyword 'placebox) (dispatch-x-y (cadr expr) (+ 150 (caddr expr)) (cadddr expr))) (else - (apply (ly-eval keyword this-module) (cdr expr)))))) + (apply (eval keyword this-module) (cdr expr)))))) (define (dispatch-x-y x y expr) - (apply (ly-eval (car expr) this-module) (append (list x y) (cdr expr)))) + (apply (eval (car expr) this-module) (append (list x y) (cdr expr)))) (define (ascii->string i) (make-string 1 (integer->char i))) @@ -86,9 +76,18 @@ "" (string-append "," (sketch-numbers->string (cdr l)))))) -(define font "") -(define output-scale 1.0) -(define (mul-scale x) (* output-scale x)) +;;;\def\scaletounit{ 2.83464566929134 mul }% + +;;(define output-scale 2.83464566929134) + +(define scale-to-unit + (cond + ((equal? (ly-unit) "mm") (/ 72.0 25.4)) + ((equal? (ly-unit) "pt") (/ 72.0 72.27)) + (else (error "unknown unit" (ly-unit))) + )) + +(define (mul-scale x) (* scale-to-unit output-scale x)) (define (sketch-filled-rectangle width dy dx height x y) (string-append @@ -100,7 +99,7 @@ (define (roundfilledbox x y dx dy w h b) - (filled-rectangle w 0 0 h x y)) + (sketch-filled-rectangle w 0 0 h x y)) (define (sketch-bezier x y l) (let* ((c0 (car (list-tail l 3))) @@ -126,13 +125,18 @@ ;; alist containing fontname -> fontcommand assoc (both strings) -(define font-alist '()) +(define font-alist '(("feta13" . ("feta13" . "13")) + ("feta20" . ("LilyPond-Feta-20" . "20")))) + +;;(define font "") +(define font (cdar font-alist)) + (define font-count 0) (define current-font "") (define (fontify x y name-mag-pair exp) (string-append (select-font name-mag-pair) - (apply (ly-eval (car exp) this-module) + (apply (eval (car exp) this-module) (append (list x y) (cdr exp))))) ;; (if (string? exp) exp ""))) @@ -146,7 +150,12 @@ "") (define (select-font name-mag-pair) - (set! font (car name-mag-pair)) + ;; name-mag-pair: (quote ("feta20" . 0.569055118110236))"feta20"(quote ("feta20" . 0.569055118110236)) + (let ((f (assoc (caadr name-mag-pair) font-alist))) + (if (pair? f) + (set! font (cdr f)) + (format #t "font not found: ~s\n" (caadr name-mag-pair)))) + ;;(write font) "") (define (font-load-command name-mag command) @@ -158,7 +167,7 @@ (list width (* slope width) 0 thick x y)))) (define (comment s) - (string-append "# " s)) + (string-append "# " s "\n")) (define (bracket arch_angle arch_width arch_height height arch_thick thick) (string-append @@ -169,13 +178,15 @@ "fp((0,0,0))\n" "le()\n" "lw(0.1)\n" - ;; "Fn('" global-font "')\n" - ;; "Fn('Times-Roman')\n" - "Fn('TeX-feta20')\n" - "Fs(20)\n" - ;; chars > 128 don't work yet - (format #f "txt('\\~o',(" (modulo i 128)) - ;; "char(" ,(number->string i) ",(" + "Fn('" (car font) "')\n" + "Fs(" (cdr font) ")\n" + ;; how to get zero-left padding with ``Guile's fprintf'' ? + ;;(format #f "txt('\\x~2x',(" i) + ;;(format #f "txt('\\x~02x',(" i) + ;; ugh uhg + (if (< i 16) + (format #f "txt('\\x0~x',(" i) + (format #f "txt('\\x~x',(" i)) (sketch-numbers->string (map mul-scale (list x y))) "))\n")) @@ -220,10 +231,13 @@ grid((0,0,20,20),0,(0,0,1),'Grid')\n") (define (header-end) "") +(define output-scale 1) + (define (lily-def key val) (if (equal? key "lilypondpaperoutputscale") ;; ugr - (set! output-scale (string->number val))) + (set! output-scale (string->number val)) + ) "") @@ -269,10 +283,16 @@ layer('Layer 1',1,1,0,0,(0,0,0)) (stop-system)) (define (text x y s) - (string-append "txt('" s "',(" (sketch-numbers->string + (string-append + "fp((0,0,0))\n" + "le()\n" + "lw(0.1)\n" + "Fn('" (car font) "')\n" + "Fs(" (cdr font) ")\n" + ;; Hmm + "txt('" s "',(" (sketch-numbers->string (map mul-scale (list x y))) "))\n")) - (define (unknown) "\n unknown\n")