From ded955452c352915d43c6ef78ba2a0f70b71ce2b Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 16 Dec 2000 16:27:51 +0100 Subject: [PATCH] patch::: 1.3.117.jcn1 1.3.117.jcn1 ============ * Resurrected direct postscript output, ie. lilypond --output-format=ps. --- CHANGES | 5 + VERSION | 2 +- buildscripts/ps-to-pfa.py | 2 +- flower/data-file.cc | 1 - flower/dstream.cc | 1 - flower/include/dictionary.hh | 4 +- lily/main.cc | 9 +- scm/ascii-script.scm | 3 +- scm/lily.scm | 525 +---------------------------------- scm/ps.scm | 250 +++++++++++++++++ scm/tex.scm | 255 +++++++++++++++++ 11 files changed, 536 insertions(+), 521 deletions(-) create mode 100644 scm/ps.scm create mode 100644 scm/tex.scm diff --git a/CHANGES b/CHANGES index fea19d21a0..59fd9cf731 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,8 @@ +1.3.117.jcn1 +============ + +* Resurrected direct postscript output, ie. lilypond --output-format=ps. + 1.3.116.jcn4 ============ diff --git a/VERSION b/VERSION index c177f64471..c343984e8e 100644 --- a/VERSION +++ b/VERSION @@ -2,7 +2,7 @@ PACKAGE_NAME=LilyPond MAJOR_VERSION=1 MINOR_VERSION=3 PATCH_LEVEL=117 -MY_PATCH_LEVEL= +MY_PATCH_LEVEL=jcn1 # use the above to send patches: MY_PATCH_LEVEL is always empty for a # released version. diff --git a/buildscripts/ps-to-pfa.py b/buildscripts/ps-to-pfa.py index d0bf000fe0..a1d80c18c9 100755 --- a/buildscripts/ps-to-pfa.py +++ b/buildscripts/ps-to-pfa.py @@ -93,7 +93,7 @@ def header (f): /FontType 3 def %% Required elements of font /FontName /%s def""" % font_name) f.write (r""" -/FontMatrix [.083 0 0 .083 0 0] def %% why .83? +/FontMatrix [.083 0 0 .083 0 0] def %% 12 is default height: 1/12 = 0.083 /FontBBox [-1000 -1000 1000 1000] def %% does not seem to matter. /Encoding 256 array def %% Trivial encoding vector 0 1 255 {Encoding exch /.notdef put} for diff --git a/flower/data-file.cc b/flower/data-file.cc index 7faabf383a..8339524cd0 100644 --- a/flower/data-file.cc +++ b/flower/data-file.cc @@ -8,7 +8,6 @@ DEPRECATED */ -#include #include #include diff --git a/flower/dstream.cc b/flower/dstream.cc index 5834c3a430..abdd5c3db0 100644 --- a/flower/dstream.cc +++ b/flower/dstream.cc @@ -5,7 +5,6 @@ (c) 1996, 1997--2000 Han-Wen Nienhuys */ - #include #include "dstream.hh" #include "dictionary-iter.hh" diff --git a/flower/include/dictionary.hh b/flower/include/dictionary.hh index 2f5e5711ca..f7eb8affce 100644 --- a/flower/include/dictionary.hh +++ b/flower/include/dictionary.hh @@ -10,10 +10,12 @@ #ifndef DICTIONARY_HH #define DICTIONARY_HH +#include + + #include "string.hh" #include "array.hh" -#include unsigned int string_hash (String); diff --git a/lily/main.cc b/lily/main.cc index b98056a375..1946e16dac 100644 --- a/lily/main.cc +++ b/lily/main.cc @@ -93,7 +93,6 @@ Long_option_init theopts[] = { void identify (ostream* os) { - //*os << gnu_lilypond_version_str () << endl; *os << gnu_lilypond_version_str (); } @@ -155,16 +154,16 @@ version () cout << endl; cout << _f ("Copyright (c) %s by", "1996--2000"); - cout << "Han-Wen Nienhuys \n" - << "Jan Nieuwenhuizen \n"; + cout << '\n'; + cout << " Han-Wen Nienhuys \n"; + cout << " Jan Nieuwenhuizen \n"; } void notice () { cout << '\n'; - // GNU GNU? - cout << _ ("GNU LilyPond -- The GNU Project music typesetter"); + cout << _ ("GNU LilyPond -- The music typesetter"); cout << '\n'; cout << _f ("Copyright (c) %s by", "1996--2000"); cout << '\n'; diff --git a/scm/ascii-script.scm b/scm/ascii-script.scm index ada96b4592..c0f0f8b79a 100644 --- a/scm/ascii-script.scm +++ b/scm/ascii-script.scm @@ -187,4 +187,5 @@ ) ) - +(define (scm-as-output) + (ly-eval (as-scm 'all-definitions))) diff --git a/scm/lily.scm b/scm/lily.scm index 007e5045b8..a9cc251bfb 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -6,7 +6,6 @@ ;;; Han-Wen Nienhuys -;;; ;;; This file contains various routines in Scheme that are easier to ;;; do here than in C++. At present it is an unorganised mess. Sorry. @@ -30,8 +29,6 @@ (define markup? (lambda (x) (or (string? x) (list? x)))) - - ;; ugh: code dup ; merge. (define (object-type obj) (cond @@ -172,9 +169,6 @@ (string-append (number->string duration) (symbol->string style)))) ) - -;;;;;;;; TeX - (define (string-encode-integer i) (cond ((= i 0) "o") @@ -233,489 +227,6 @@ (not (eq? #f (memq symbol (ly-get-elt-property elt 'interfaces)))) )) -;;;;;;;;;;;;;;;;;;; TeX output -(define (tex-scm action-name) - (define (unknown) - "%\n\\unknown%\n") - - - (define (select-font name-mag-pair) - (let* - ( - (c (assoc name-mag-pair font-name-alist)) - ) - - (if (eq? c #f) - (begin - (display "FAILED\n") - (display (object-type (car name-mag-pair))) - (display (object-type (caaar font-name-alist))) - - (ly-warn (string-append - "Programming error: No such font known " - (car name-mag-pair) " " - (number->string (cdr name-mag-pair)) - )) - "") ; issue no command - (string-append "\\" (cddr c))) - - - )) - - (define (beam width slope thick) - (embedded-ps ((ps-scm 'beam) width slope thick))) - - (define (bracket arch_angle arch_width arch_height width height arch_thick thick) - (embedded-ps ((ps-scm 'bracket) arch_angle arch_width arch_height width height arch_thick thick))) - - (define (dashed-slur thick dash l) - (embedded-ps ((ps-scm 'dashed-slur) thick dash l))) - - (define (crescendo thick w h cont) - (embedded-ps ((ps-scm 'crescendo) thick w h cont))) - - (define (char i) - (string-append "\\char" (inexact->string i 10) " ")) - - (define (dashed-line thick on off dx dy) - (embedded-ps ((ps-scm 'dashed-line) thick on off dx dy))) - - (define (decrescendo thick w h cont) - (embedded-ps ((ps-scm 'decrescendo) thick w h cont))) - - (define (font-load-command name-mag command) - (string-append - "\\font\\" command "=" - (car name-mag) - " scaled " - (number->string (inexact->exact (* 1000 (cdr name-mag)))) - "\n")) - - (define (embedded-ps s) - (string-append "\\embeddedps{" s "}")) - - (define (comment s) - (string-append "% " s)) - - (define (end-output) - (begin -; uncomment for some stats about lily memory -; (display (gc-stats)) - (string-append "\n\\EndLilyPondOutput" - ; Put GC stats here. - ))) - - (define (experimental-on) - "") - - (define (font-switch i) - (string-append - "\\" (font i) "\n")) - - (define (font-def i s) - (string-append - "\\font" (font-switch i) "=" s "\n")) - - (define (header-end) - (string-append - "\\special{! " - - ;; URG: ly-gulp-file: now we can't use scm output without Lily - (if use-regex - ;; fixed in 1.3.4 for powerpc -- broken on Windows - (regexp-substitute/global #f "\n" - (ly-gulp-file "lily.ps") 'pre " %\n" 'post) - (ly-gulp-file "lily.ps")) - "}" - "\\input lilyponddefs\\newdimen\\outputscale \\outputscale=\\lilypondpaperoutputscale pt\\turnOnPostScript")) - - (define (header creator generate) - (string-append - "%created by: " creator generate "\n")) - - (define (invoke-char s i) - (string-append - "\n\\" s "{" (inexact->string i 10) "}" )) - - (define (invoke-dim1 s d) - (string-append - "\n\\" s "{" (number->dim d) "}")) - (define (pt->sp x) - (* 65536 x)) - - ;; - ;; need to do something to make this really safe. - ;; - (define (output-tex-string s) - (if security-paranoia - (if use-regex - (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post) - (begin (display "warning: not paranoid") (newline) s)) - s)) - - (define (lily-def key val) - (string-append - "\\def\\" - (if use-regex - ;; fixed in 1.3.4 for powerpc -- broken on Windows - (regexp-substitute/global #f "_" - (output-tex-string key) 'pre "X" 'post) - (output-tex-string key)) - "{" (output-tex-string val) "}\n")) - - (define (number->dim x) - (string-append - (ly-number->string x) " \\outputscale ")) - - (define (placebox x y s) - (string-append - "\\placebox{" - (number->dim y) "}{" (number->dim x) "}{" s "}\n")) - - (define (bezier-sandwich l thick) - (embedded-ps ((ps-scm 'bezier-sandwich) l thick))) - - (define (start-line ht) - (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n")) - - (define (stop-line) - "}\\vss}\\interscoreline\n") - (define (stop-last-line) - "}\\vss}") - (define (filledbox breapth width depth height) - (string-append - "\\kern" (number->dim (- breapth)) - "\\vrule width " (number->dim (+ breapth width)) - "depth " (number->dim depth) - "height " (number->dim height) " ")) - - (define (text s) - (string-append "\\hbox{" (output-tex-string s) "}")) - - (define (tuplet ht gapx dx dy thick dir) - (embedded-ps ((ps-scm 'tuplet) ht gapx dx dy thick dir))) - - (define (volta h w thick vert_start vert_end) - (embedded-ps ((ps-scm 'volta) h w thick vert_start vert_end))) - - (define (define-origin file line col) - ; use this for column positions - (if point-and-click - (string-append "\\special{src:" (number->string line) ":" - (number->string col) " " file "}" - ;; arg, the clueless take over the mailing list... -; "\\special{-****-These-warnings-are-harmless-***}" -; "\\special{-****-PLEASE-read-http://appel.lilypond.org/wiki/index.php3?PostProcessing-****}" - ) - "") - - ; line numbers only: - ;(string-append "\\special{src:" (number->string line) " " file "}") -) - - ; no-origin not yet supported by Xdvi - (define (no-origin) "") - - ;; TeX - ;; The procedures listed below form the public interface of TeX-scm. - ;; (should merge the 2 lists) - (cond ((eq? action-name 'all-definitions) - `(begin - (define font-load-command ,font-load-command) - (define beam ,beam) - (define bezier-sandwich ,bezier-sandwich) - (define bracket ,bracket) - (define char ,char) - (define crescendo ,crescendo) - (define dashed-line ,dashed-line) - (define dashed-slur ,dashed-slur) - (define decrescendo ,decrescendo) - (define end-output ,end-output) - (define experimental-on ,experimental-on) - (define filledbox ,filledbox) - (define font-def ,font-def) - (define font-switch ,font-switch) - (define header-end ,header-end) - (define lily-def ,lily-def) - (define header ,header) - (define invoke-char ,invoke-char) - (define invoke-dim1 ,invoke-dim1) - (define placebox ,placebox) - (define select-font ,select-font) - (define start-line ,start-line) - (define stop-line ,stop-line) - (define stop-last-line ,stop-last-line) - (define text ,text) - (define tuplet ,tuplet) - (define volta ,volta) - (define define-origin ,define-origin) - (define no-origin ,no-origin) - )) - - ((eq? action-name 'beam) beam) - ((eq? action-name 'tuplet) tuplet) - ((eq? action-name 'bracket) bracket) - ((eq? action-name 'crescendo) crescendo) - ((eq? action-name 'dashed-line) dashed-line) - ((eq? action-name 'dashed-slur) dashed-slur) - ((eq? action-name 'decrescendo) decrescendo) - ((eq? action-name 'end-output) end-output) - ((eq? action-name 'experimental-on) experimental-on) - ((eq? action-name 'font-def) font-def) - ((eq? action-name 'font-switch) font-switch) - ((eq? action-name 'header-end) header-end) - ((eq? action-name 'lily-def) lily-def) - ((eq? action-name 'header) header) - ((eq? action-name 'invoke-char) invoke-char) - ((eq? action-name 'invoke-dim1) invoke-dim1) - ((eq? action-name 'placebox) placebox) - ((eq? action-name 'bezier-sandwich) bezier-sandwich) - ((eq? action-name 'start-line) start-line) - ((eq? action-name 'stem) stem) - ((eq? action-name 'stop-line) stop-line) - ((eq? action-name 'stop-last-line) stop-last-line) - ((eq? action-name 'volta) volta) - (else (error "unknown tag -- PS-TEX " action-name)) - ) - ) - - -;;;;;;;;;;;; PS -(define (ps-scm action-name) - - ;; alist containing fontname -> fontcommand assoc (both strings) - (define font-alist '()) - (define font-count 0) - (define current-font "") - - - (define (cached-fontname i) - (string-append - "lilyfont" - (make-string 1 (integer->char (+ 65 i))))) - - - (define (select-font name-mag-pair) - (let* - ( - (c (assoc name-mag-pair font-name-alist)) - ) - - (if (eq? c #f) - (begin - (display name-mag-pair) - (display font-name-alist) - (ly-warn (string-append - "Programming error: No such font known " (car name-mag-pair)) - (number->string (cdr name-mag-pair)) - ) - - "") ; issue no command - (string-append " " (cdr c) " ")) - )) - - (define (font-load-command name-mag command) - (string-append - "/" command - " { /" - (symbol->string (car name-mag)) - " findfont " - (number->string (cdr name-mag)) - " 1000 div 12 mul scalefont setfont } bind def " - "\n")) - - - (define (beam width slope thick) - (string-append - (numbers->string (list width slope thick)) " draw_beam" )) - - (define (comment s) - (string-append "% " s)) - - (define (bracket arch_angle arch_width arch_height width height arch_thick thick) - (string-append - (numbers->string (list arch_angle arch_width arch_height width height arch_thick thick)) " draw_bracket" )) - - (define (char i) - (invoke-char " show" i)) - - (define (crescendo thick w h cont ) - (string-append - (numbers->string (list w h (inexact->exact cont) thick)) - " draw_crescendo")) - - ;; what the heck is this interface ? - (define (dashed-slur thick dash l) - (string-append - (apply string-append (map control->string l)) - (number->string thick) - " [ " - (number->string dash) - " " - (number->string (* 10 thick)) ;UGH. 10 ? - " ] 0 draw_dashed_slur")) - - (define (dashed-line thick on off dx dy) - (string-append - (number->string dx) - " " - (number->string dy) - " " - (number->string thick) - " [ " - (number->string on) - " " - (number->string off) - " ] 0 draw_dashed_line")) - - (define (decrescendo thick w h cont) - (string-append - (numbers->string (list w h (inexact->exact cont) thick)) - " draw_decrescendo")) - - - (define (end-output) - "\nshowpage\n") - - (define (experimental-on) "") - - (define (filledbox breapth width depth height) - (string-append (numbers->string (list breapth width depth height)) - " draw_box" )) - - ;; obsolete? - (define (font-def i s) - (string-append - "\n/" (font i) " {/" - (substring s 0 (- (string-length s) 4)) - " findfont 12 scalefont setfont} bind def \n")) - - (define (font-switch i) - (string-append (font i) " ")) - - (define (header-end) - (string-append - ;; URG: now we can't use scm output without Lily - (ly-gulp-file "lilyponddefs.ps") - " {exch pop //systemdict /run get exec} " - (ly-gulp-file "lily.ps") - "{ exch pop //systemdict /run get exec } " - )) - - (define (lily-def key val) - - (if (string=? (substring key 0 (min (string-length "lilypondpaper") (string-length key))) "lilypondpaper") - (string-append "/" key " {" val "} bind def\n") - (string-append "/" key " (" val ") def\n") - ) - ) - - (define (header creator generate) - (string-append - "%!PS-Adobe-3.0\n" - "%%Creator: " creator generate "\n")) - - (define (invoke-char s i) - (string-append - "(\\" (inexact->string i 8) ") " s " " )) - - (define (invoke-dim1 s d) - (string-append - (number->string (* d (/ 72.27 72))) " " s )) - - (define (placebox x y s) - (string-append - (number->string x) " " (number->string y) " {" s "} placebox ")) - - (define (bezier-sandwich l thick) - (string-append - (apply string-append (map control->string l)) - (number->string thick) - " draw_bezier_sandwich")) - - (define (start-line height) - "\nstart_line {\n") - - (define (stem breapth width depth height) - (string-append (numbers->string (list breapth width depth height)) - " draw_box" )) - - (define (stop-line) - "}\nstop_line\n") - - (define (text s) - (string-append "(" s ") show ")) - - - (define (volta h w thick vert_start vert_end) - (string-append - (numbers->string (list h w thick (inexact->exact vert_start) (inexact->exact vert_end))) - " draw_volta")) - - (define (tuplet ht gap dx dy thick dir) - (string-append - (numbers->string (list ht gap dx dy thick (inexact->exact dir))) - " draw_tuplet")) - - - (define (unknown) - "\n unknown\n") - - - (define (define-origin a b c ) "") - (define (no-origin) "") - - ;; PS - (cond ((eq? action-name 'all-definitions) - `(begin - (define beam ,beam) - (define tuplet ,tuplet) - (define bracket ,bracket) - (define char ,char) - (define crescendo ,crescendo) - (define volta ,volta) - (define bezier-sandwich ,bezier-sandwich) - (define dashed-line ,dashed-line) - (define dashed-slur ,dashed-slur) - (define decrescendo ,decrescendo) - (define end-output ,end-output) - (define experimental-on ,experimental-on) - (define filledbox ,filledbox) - (define font-def ,font-def) - (define font-switch ,font-switch) - (define header-end ,header-end) - (define lily-def ,lily-def) - (define font-load-command ,font-load-command) - (define header ,header) - (define invoke-char ,invoke-char) - (define invoke-dim1 ,invoke-dim1) - (define placebox ,placebox) - (define select-font ,select-font) - (define start-line ,start-line) - (define stem ,stem) - (define stop-line ,stop-line) - (define stop-last-line ,stop-line) - (define text ,text) - (define no-origin ,no-origin) - (define define-origin ,define-origin) - )) - ((eq? action-name 'tuplet) tuplet) - ((eq? action-name 'beam) beam) - ((eq? action-name 'bezier-sandwich) bezier-sandwich) - ((eq? action-name 'bracket) bracket) - ((eq? action-name 'char) char) - ((eq? action-name 'crescendo) crescendo) - ((eq? action-name 'dashed-line) dashed-line) - ((eq? action-name 'dashed-slur) dashed-slur) - ((eq? action-name 'decrescendo) decrescendo) - ((eq? action-name 'experimental-on) experimental-on) - ((eq? action-name 'filledbox) filledbox) - ((eq? action-name 'select-font) select-font) - ((eq? action-name 'volta) volta) - (else (error "unknown tag -- PS-SCM " action-name)) - ) - ) - (define (arg->string arg) (cond ((number? arg) (inexact->string arg 10)) @@ -755,14 +266,6 @@ (gulp-file path) (gulp-file name)))) -(define (scm-tex-output) - (ly-eval (tex-scm 'all-definitions))) - -(define (scm-ps-output) - (ly-eval (ps-scm 'all-definitions))) - -(define (scm-as-output) - (ly-eval (as-scm 'all-definitions))) (define (index-cell cell dir) (if (equal? dir 1) @@ -908,16 +411,18 @@ (map (lambda (x) (eval-string (ly-gulp-file x))) - - '("backend-property.scm" - "translator-properties.scm" - "interface.scm" - "beam.scm" - "slur.scm" - "font.scm" - "auto-beam.scm" - "generic-property.scm" - "basic-properties.scm" - "chord-name.scm" - "element-descriptions.scm" - )) + '("tex.scm" + "ps.scm" +; "ascii-script.scm" + "backend-property.scm" + "translator-properties.scm" + "interface.scm" + "beam.scm" + "slur.scm" + "font.scm" + "auto-beam.scm" + "generic-property.scm" + "basic-properties.scm" + "chord-name.scm" + "element-descriptions.scm" + )) diff --git a/scm/ps.scm b/scm/ps.scm new file mode 100644 index 0000000000..be85c4c373 --- /dev/null +++ b/scm/ps.scm @@ -0,0 +1,250 @@ +;;; ps.scm -- implement Scheme output routines for PostScript +;;; +;;; source file of the GNU LilyPond music typesetter +;;; +;;; (c) 1998--2000 Jan Nieuwenhuizen +;;; Han-Wen Nienhuys + + +(define (ps-scm action-name) + + ;; alist containing fontname -> fontcommand assoc (both strings) + (define font-alist '()) + (define font-count 0) + (define current-font "") + + + (define (cached-fontname i) + (string-append + "lilyfont" + (make-string 1 (integer->char (+ 65 i))))) + + + (define (select-font name-mag-pair) + (let* + ( + (c (assoc name-mag-pair font-name-alist)) + ) + + (if (eq? c #f) + (begin + (display "FAILED\n") + (display (object-type (car name-mag-pair))) + (display (object-type (caaar font-name-alist))) + + (ly-warn (string-append + "Programming error: No such font known " + (car name-mag-pair) " " + (number->string (cdr name-mag-pair)) + )) + + "") ; issue no command + (string-append " " (cddr c) " ")) + )) + + (define (font-load-command name-mag command) + (string-append + "/" command + " { /" + (car name-mag) + " findfont " + "12 " (number->string (cdr name-mag)) " mul " + "lilypondpaperoutputscale div scalefont setfont } bind def " + "\n")) + + + (define (beam width slope thick) + (string-append + (numbers->string (list width slope thick)) " draw_beam" )) + + (define (comment s) + (string-append "% " s)) + + (define (bracket arch_angle arch_width arch_height width height arch_thick thick) + (string-append + (numbers->string (list arch_angle arch_width arch_height width height arch_thick thick)) " draw_bracket" )) + + (define (char i) + (invoke-char " show" i)) + + (define (crescendo thick w h cont ) + (string-append + (numbers->string (list w h (inexact->exact cont) thick)) + " draw_crescendo")) + + ;; what the heck is this interface ? + (define (dashed-slur thick dash l) + (string-append + (apply string-append (map control->string l)) + (number->string thick) + " [ " + (number->string dash) + " " + (number->string (* 10 thick)) ;UGH. 10 ? + " ] 0 draw_dashed_slur")) + + (define (dashed-line thick on off dx dy) + (string-append + (number->string dx) + " " + (number->string dy) + " " + (number->string thick) + " [ " + (number->string on) + " " + (number->string off) + " ] 0 draw_dashed_line")) + + (define (decrescendo thick w h cont) + (string-append + (numbers->string (list w h (inexact->exact cont) thick)) + " draw_decrescendo")) + + + (define (end-output) + "\nshowpage\n") + + (define (experimental-on) "") + + (define (filledbox breapth width depth height) + (string-append (numbers->string (list breapth width depth height)) + " draw_box" )) + + ;; obsolete? + (define (font-def i s) + (string-append + "\n/" (font i) " {/" + (substring s 0 (- (string-length s) 4)) + " findfont 12 scalefont setfont} bind def \n")) + + (define (font-switch i) + (string-append (font i) " ")) + + (define (header-end) + (string-append + ;; URG: now we can't use scm output without Lily + (ly-gulp-file "lilyponddefs.ps") + " {exch pop //systemdict /run get exec} " + (ly-gulp-file "lily.ps") + "{ exch pop //systemdict /run get exec } " + )) + + (define (lily-def key val) + + (if (string=? (substring key 0 (min (string-length "lilypondpaper") (string-length key))) "lilypondpaper") + (string-append "/" key " {" val "} bind def\n") + (string-append "/" key " (" val ") def\n") + ) + ) + + (define (header creator generate) + (string-append + "%!PS-Adobe-3.0\n" + "%%Creator: " creator generate "\n")) + + (define (invoke-char s i) + (string-append + "(\\" (inexact->string i 8) ") " s " " )) + + (define (invoke-dim1 s d) + (string-append + (number->string (* d (/ 72.27 72))) " " s )) + + (define (placebox x y s) + (string-append + (number->string x) " " (number->string y) " {" s "} placebox ")) + + (define (bezier-sandwich l thick) + (string-append + (apply string-append (map control->string l)) + (number->string thick) + " draw_bezier_sandwich")) + + (define (start-line height) + "\nstart_line { +lilypondpaperoutputscale lilypondpaperoutputscale scale +") + + (define (stem breapth width depth height) + (string-append (numbers->string (list breapth width depth height)) + " draw_box" )) + + (define (stop-line) + "}\nstop_line\n") + + (define (text s) + (string-append "(" s ") show ")) + + + (define (volta h w thick vert_start vert_end) + (string-append + (numbers->string (list h w thick (inexact->exact vert_start) (inexact->exact vert_end))) + " draw_volta")) + + (define (tuplet ht gap dx dy thick dir) + (string-append + (numbers->string (list ht gap dx dy thick (inexact->exact dir))) + " draw_tuplet")) + + + (define (unknown) + "\n unknown\n") + + + (define (define-origin a b c ) "") + (define (no-origin) "") + + ;; PS + (cond ((eq? action-name 'all-definitions) + `(begin + (define beam ,beam) + (define tuplet ,tuplet) + (define bracket ,bracket) + (define char ,char) + (define crescendo ,crescendo) + (define volta ,volta) + (define bezier-sandwich ,bezier-sandwich) + (define dashed-line ,dashed-line) + (define dashed-slur ,dashed-slur) + (define decrescendo ,decrescendo) + (define end-output ,end-output) + (define experimental-on ,experimental-on) + (define filledbox ,filledbox) + (define font-def ,font-def) + (define font-switch ,font-switch) + (define header-end ,header-end) + (define lily-def ,lily-def) + (define font-load-command ,font-load-command) + (define header ,header) + (define invoke-char ,invoke-char) + (define invoke-dim1 ,invoke-dim1) + (define placebox ,placebox) + (define select-font ,select-font) + (define start-line ,start-line) + (define stem ,stem) + (define stop-line ,stop-line) + (define stop-last-line ,stop-line) + (define text ,text) + (define no-origin ,no-origin) + (define define-origin ,define-origin) + )) + ((eq? action-name 'tuplet) tuplet) + ((eq? action-name 'beam) beam) + ((eq? action-name 'bezier-sandwich) bezier-sandwich) + ((eq? action-name 'bracket) bracket) + ((eq? action-name 'char) char) + ((eq? action-name 'crescendo) crescendo) + ((eq? action-name 'dashed-line) dashed-line) + ((eq? action-name 'dashed-slur) dashed-slur) + ((eq? action-name 'decrescendo) decrescendo) + ((eq? action-name 'experimental-on) experimental-on) + ((eq? action-name 'filledbox) filledbox) + ((eq? action-name 'select-font) select-font) + ((eq? action-name 'volta) volta) + (else (error "unknown tag -- PS-SCM " action-name)) + ) + ) + +(define (scm-ps-output) + (ly-eval (ps-scm 'all-definitions))) diff --git a/scm/tex.scm b/scm/tex.scm new file mode 100644 index 0000000000..85260f0390 --- /dev/null +++ b/scm/tex.scm @@ -0,0 +1,255 @@ +;;; tex.scm -- implement Scheme output routines for TeX +;;; +;;; source file of the GNU LilyPond music typesetter +;;; +;;; (c) 1998--2000 Jan Nieuwenhuizen +;;; Han-Wen Nienhuys + + +(define (tex-scm action-name) + (define (unknown) + "%\n\\unknown%\n") + + + (define (select-font name-mag-pair) + (let* + ( + (c (assoc name-mag-pair font-name-alist)) + ) + + (if (eq? c #f) + (begin + (display "FAILED\n") + (display (object-type (car name-mag-pair))) + (display (object-type (caaar font-name-alist))) + + (ly-warn (string-append + "Programming error: No such font known " + (car name-mag-pair) " " + (number->string (cdr name-mag-pair)) + )) + "") ; issue no command + (string-append "\\" (cddr c))) + + + )) + + (define (beam width slope thick) + (embedded-ps ((ps-scm 'beam) width slope thick))) + + (define (bracket arch_angle arch_width arch_height width height arch_thick thick) + (embedded-ps ((ps-scm 'bracket) arch_angle arch_width arch_height width height arch_thick thick))) + + (define (dashed-slur thick dash l) + (embedded-ps ((ps-scm 'dashed-slur) thick dash l))) + + (define (crescendo thick w h cont) + (embedded-ps ((ps-scm 'crescendo) thick w h cont))) + + (define (char i) + (string-append "\\char" (inexact->string i 10) " ")) + + (define (dashed-line thick on off dx dy) + (embedded-ps ((ps-scm 'dashed-line) thick on off dx dy))) + + (define (decrescendo thick w h cont) + (embedded-ps ((ps-scm 'decrescendo) thick w h cont))) + + (define (font-load-command name-mag command) + (string-append + "\\font\\" command "=" + (car name-mag) + " scaled " + (number->string (inexact->exact (* 1000 (cdr name-mag)))) + "\n")) + + (define (embedded-ps s) + (string-append "\\embeddedps{" s "}")) + + (define (comment s) + (string-append "% " s)) + + (define (end-output) + (begin +; uncomment for some stats about lily memory +; (display (gc-stats)) + (string-append "\n\\EndLilyPondOutput" + ; Put GC stats here. + ))) + + (define (experimental-on) + "") + + (define (font-switch i) + (string-append + "\\" (font i) "\n")) + + (define (font-def i s) + (string-append + "\\font" (font-switch i) "=" s "\n")) + + (define (header-end) + (string-append + "\\special{! " + + ;; URG: ly-gulp-file: now we can't use scm output without Lily + (if use-regex + ;; fixed in 1.3.4 for powerpc -- broken on Windows + (regexp-substitute/global #f "\n" + (ly-gulp-file "lily.ps") 'pre " %\n" 'post) + (ly-gulp-file "lily.ps")) + "}" + "\\input lilyponddefs\\newdimen\\outputscale \\outputscale=\\lilypondpaperoutputscale pt\\turnOnPostScript")) + + (define (header creator generate) + (string-append + "%created by: " creator generate "\n")) + + (define (invoke-char s i) + (string-append + "\n\\" s "{" (inexact->string i 10) "}" )) + + (define (invoke-dim1 s d) + (string-append + "\n\\" s "{" (number->dim d) "}")) + (define (pt->sp x) + (* 65536 x)) + + ;; + ;; need to do something to make this really safe. + ;; + (define (output-tex-string s) + (if security-paranoia + (if use-regex + (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post) + (begin (display "warning: not paranoid") (newline) s)) + s)) + + (define (lily-def key val) + (string-append + "\\def\\" + (if use-regex + ;; fixed in 1.3.4 for powerpc -- broken on Windows + (regexp-substitute/global #f "_" + (output-tex-string key) 'pre "X" 'post) + (output-tex-string key)) + "{" (output-tex-string val) "}\n")) + + (define (number->dim x) + (string-append + (ly-number->string x) " \\outputscale ")) + + (define (placebox x y s) + (string-append + "\\placebox{" + (number->dim y) "}{" (number->dim x) "}{" s "}\n")) + + (define (bezier-sandwich l thick) + (embedded-ps ((ps-scm 'bezier-sandwich) l thick))) + + (define (start-line ht) + (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n")) + + (define (stop-line) + "}\\vss}\\interscoreline\n") + (define (stop-last-line) + "}\\vss}") + (define (filledbox breapth width depth height) + (string-append + "\\kern" (number->dim (- breapth)) + "\\vrule width " (number->dim (+ breapth width)) + "depth " (number->dim depth) + "height " (number->dim height) " ")) + + (define (text s) + (string-append "\\hbox{" (output-tex-string s) "}")) + + (define (tuplet ht gapx dx dy thick dir) + (embedded-ps ((ps-scm 'tuplet) ht gapx dx dy thick dir))) + + (define (volta h w thick vert_start vert_end) + (embedded-ps ((ps-scm 'volta) h w thick vert_start vert_end))) + + (define (define-origin file line col) + ; use this for column positions + (if point-and-click + (string-append "\\special{src:" (number->string line) ":" + (number->string col) " " file "}" + ;; arg, the clueless take over the mailing list... +; "\\special{-****-These-warnings-are-harmless-***}" +; "\\special{-****-PLEASE-read-http://appel.lilypond.org/wiki/index.php3?PostProcessing-****}" + ) + "") + + ; line numbers only: + ;(string-append "\\special{src:" (number->string line) " " file "}") +) + + ; no-origin not yet supported by Xdvi + (define (no-origin) "") + + ;; TeX + ;; The procedures listed below form the public interface of TeX-scm. + ;; (should merge the 2 lists) + (cond ((eq? action-name 'all-definitions) + `(begin + (define font-load-command ,font-load-command) + (define beam ,beam) + (define bezier-sandwich ,bezier-sandwich) + (define bracket ,bracket) + (define char ,char) + (define crescendo ,crescendo) + (define dashed-line ,dashed-line) + (define dashed-slur ,dashed-slur) + (define decrescendo ,decrescendo) + (define end-output ,end-output) + (define experimental-on ,experimental-on) + (define filledbox ,filledbox) + (define font-def ,font-def) + (define font-switch ,font-switch) + (define header-end ,header-end) + (define lily-def ,lily-def) + (define header ,header) + (define invoke-char ,invoke-char) + (define invoke-dim1 ,invoke-dim1) + (define placebox ,placebox) + (define select-font ,select-font) + (define start-line ,start-line) + (define stop-line ,stop-line) + (define stop-last-line ,stop-last-line) + (define text ,text) + (define tuplet ,tuplet) + (define volta ,volta) + (define define-origin ,define-origin) + (define no-origin ,no-origin) + )) + + ((eq? action-name 'beam) beam) + ((eq? action-name 'tuplet) tuplet) + ((eq? action-name 'bracket) bracket) + ((eq? action-name 'crescendo) crescendo) + ((eq? action-name 'dashed-line) dashed-line) + ((eq? action-name 'dashed-slur) dashed-slur) + ((eq? action-name 'decrescendo) decrescendo) + ((eq? action-name 'end-output) end-output) + ((eq? action-name 'experimental-on) experimental-on) + ((eq? action-name 'font-def) font-def) + ((eq? action-name 'font-switch) font-switch) + ((eq? action-name 'header-end) header-end) + ((eq? action-name 'lily-def) lily-def) + ((eq? action-name 'header) header) + ((eq? action-name 'invoke-char) invoke-char) + ((eq? action-name 'invoke-dim1) invoke-dim1) + ((eq? action-name 'placebox) placebox) + ((eq? action-name 'bezier-sandwich) bezier-sandwich) + ((eq? action-name 'start-line) start-line) + ((eq? action-name 'stem) stem) + ((eq? action-name 'stop-line) stop-line) + ((eq? action-name 'stop-last-line) stop-last-line) + ((eq? action-name 'volta) volta) + (else (error "unknown tag -- PS-TEX " action-name)) + ) + ) + +(define (scm-tex-output) + (ly-eval (tex-scm 'all-definitions))) -- 2.39.5