+1.3.117.jcn1
+============
+
+* Resurrected direct postscript output, ie. lilypond --output-format=ps.
+
1.3.116.jcn4
============
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.
/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
DEPRECATED
*/
-#include <fstream.h>
#include <ctype.h>
#include <stdlib.h>
(c) 1996, 1997--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
*/
-
#include <fstream.h>
#include "dstream.hh"
#include "dictionary-iter.hh"
#ifndef DICTIONARY_HH
#define DICTIONARY_HH
+#include <map>
+
+
#include "string.hh"
#include "array.hh"
-#include <map>
unsigned int string_hash (String);
void
identify (ostream* os)
{
- //*os << gnu_lilypond_version_str () << endl;
*os << gnu_lilypond_version_str ();
}
cout << endl;
cout << _f ("Copyright (c) %s by", "1996--2000");
- cout << "Han-Wen Nienhuys <hanwen@cs.uu.nl>\n"
- << "Jan Nieuwenhuizen <janneke@gnu.org>\n";
+ cout << '\n';
+ cout << " Han-Wen Nienhuys <hanwen@cs.uu.nl>\n";
+ cout << " Jan Nieuwenhuizen <janneke@gnu.org>\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';
)
)
-
+(define (scm-as-output)
+ (ly-eval (as-scm 'all-definitions)))
;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
-;;;
;;; This file contains various routines in Scheme that are easier to
;;; do here than in C++. At present it is an unorganised mess. Sorry.
(define markup?
(lambda (x) (or (string? x) (list? x))))
-
-
;; ugh: code dup ; merge.
(define (object-type obj)
(cond
(string-append (number->string duration) (symbol->string style))))
)
-
-;;;;;;;; TeX
-
(define (string-encode-integer i)
(cond
((= i 0) "o")
(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))
(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)
(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"
+ ))
--- /dev/null
+;;; ps.scm -- implement Scheme output routines for PostScript
+;;;
+;;; source file of the GNU LilyPond music typesetter
+;;;
+;;; (c) 1998--2000 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+
+(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)))
--- /dev/null
+;;; tex.scm -- implement Scheme output routines for TeX
+;;;
+;;; source file of the GNU LilyPond music typesetter
+;;;
+;;; (c) 1998--2000 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+
+(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)))
projects / lilypond.git / commitdiff