Hi everybody!
For those who are interested: Here is version 3 of my cairo experiments.
All stencil commands (with the obvious exception 'embedded-ps') are supported,
standard PDF metadata tags can be used.
Attached is the patch (based on git master) and a stenciltest.ly test source.
Knut
>From 8047e3d4b638b53b8e12faf359fd034c2b6996af Mon Sep 17 00:00:00 2001
From: Knut Petersen <knup...@gmail.com>
Date: Tue, 8 Jun 2021 23:09:02 +0200
Subject: [PATCH] CAIRO: playing and testing version 3
Test Cairo 1.16 as a new tool to generate PDF files.
All stencil commands are supported now.
If the command line includes '-c', basename.cairo.pdf
will be produced by lilypond in addition to basename.pdf
and/or basename.ps
Known problems:
Internal page hyperlinks: If page is a forward reference
(a link to a page that has not been generated yet) cairo
silently fails to generate correct hyperlink. As this is
behaviour is not documented I tend to believe that it is
a cairo 1.16 bug, but I have to verify that assumption.
Only setting of standard PDF metadata tags is supported
('Author', 'Title', 'Subject', 'Keywords' and 'Creator').
Creation time and pdf producer are set automatically.
Some seldom used pdf features are not supported (e.g.
embedding the lilypond source file into the pdf document).
If a dashed line ends with a line segment of lenth 0,
ghostscript will not print the line caps of that segment,
cairo will print them. I tend to ignore that fact.
For obvious reasons the \postscript and \epsfile do not
work, a warning will be emitted.
Those nice games we played with ghostscript to produce
'broken but useful' pdfs. Hint: 'gs-never-embed-fonts',
'music-font-encodings', etc ...
ToDo:
A lot of things. ;-)
Please test and send comments to
'Knut Petersen' <knup...@gmail.com>
---
aclocal.m4 | 12 +
config.make.in | 5 +-
configure.ac | 1 +
lily/cairo.cc | 975 +++++++++++++++++++++++++++++++++++++++++++
lily/main.cc | 10 +
scm/framework-ps.scm | 17 +-
scm/lily.scm | 2 +
scm/output-ps.scm | 64 ++-
8 files changed, 1067 insertions(+), 19 deletions(-)
create mode 100644 lily/cairo.cc
diff --git a/aclocal.m4 b/aclocal.m4
index 0897ead7ab..094585a090 100644
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -857,6 +857,18 @@ AC_DEFUN(STEPMAKE_GOBJECT, [
fi
])
+AC_DEFUN(STEPMAKE_CAIRO, [
+ PKG_CHECK_MODULES(CAIRO, $1 >= $3, have_cairo=yes, true)
+ if test "$have_cairo" = yes; then
+ AC_DEFINE(HAVE_CAIRO)
+ AC_SUBST(CAIRO_CFLAGS)
+ AC_SUBST(CAIRO_LIBS)
+ else
+ r="cairo-devel"
+ ver="`$PKG_CONFIG --modversion $1`"
+ STEPMAKE_ADD_ENTRY($2, ["$r >= $3 (installed: $ver)"])
+ fi
+])
AC_DEFUN(STEPMAKE_FREETYPE2, [
PKG_CHECK_MODULES(FREETYPE2, $1 >= $3, have_freetype2=yes, true)
diff --git a/config.make.in b/config.make.in
index a2f40565ce..395833ca07 100644
--- a/config.make.in
+++ b/config.make.in
@@ -13,10 +13,10 @@ AR = @AR@
BISON = @BISON@
CC = @CC@
CONFIG_CPPFLAGS = $(FLEXLEXER_CPPFLAGS) @CPPFLAGS@
-CONFIG_CXXFLAGS = @CXXFLAGS@ $(GUILE_CFLAGS) $(FREETYPE2_CFLAGS) $(PANGO_FT2_CFLAGS)
+CONFIG_CXXFLAGS = @CXXFLAGS@ $(GUILE_CFLAGS) $(FREETYPE2_CFLAGS) $(PANGO_FT2_CFLAGS) @CAIRO_CFLAGS@
CONFIG_DEFINES = @DEFINES@
CONFIG_LDFLAGS = @LDFLAGS@
-CONFIG_LIBS = @LIBS@ @EXTRA_LIBS@ @GLIB_LIBS@ @GUILE_LIBS@ @PANGO_FT2_LIBS@ @FONTCONFIG_LIBS@ @FREETYPE2_LIBS@
+CONFIG_LIBS = @LIBS@ @EXTRA_LIBS@ @GLIB_LIBS@ @GUILE_LIBS@ @PANGO_FT2_LIBS@ @FONTCONFIG_LIBS@ @FREETYPE2_LIBS@ @CAIRO_LIBS@
CROSS = @cross_compiling@
CXX = @CXX@
CXXABI_LIBS = @CXXABI_LIBS@
@@ -31,6 +31,7 @@ FLEX = @FLEX@
FONTCONFIG_LIBS = @FONTCONFIG_LIBS@
FONTFORGE = @FONTFORGE@
FREETYPE2_LIBS = @FREETYPE2_LIBS@
+CAIRO_LIBS = @CAIRO_LIBS@
GLIB_LIBS = @GLIB_LIBS@ @GOBJECT_LIBS@
GS_API = @GS_API@
GS920 = @GS920@
diff --git a/configure.ac b/configure.ac
index 5806508371..1452b8eb3f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -320,6 +320,7 @@ if test "$have_pangoft2_with_otf_feature" != yes ; then
fi
STEPMAKE_FONTCONFIG(fontconfig, REQUIRED, 2.4.0)
STEPMAKE_FREETYPE2(freetype2, REQUIRED, 2.3.9)
+STEPMAKE_CAIRO(cairo, REQUIRED, 1.16.0)
STEPMAKE_GLIB(glib-2.0, REQUIRED, 2.38)
STEPMAKE_GOBJECT(gobject-2.0, REQUIRED, 2.38)
diff --git a/lily/cairo.cc b/lily/cairo.cc
new file mode 100644
index 0000000000..1ad0f114ba
--- /dev/null
+++ b/lily/cairo.cc
@@ -0,0 +1,975 @@
+/*
+ This file is part of LilyPond, the GNU music typesetter.
+
+ Copyright (C) 2021 Knut Petersen <knup...@gmail.com>
+
+ LilyPond is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ LilyPond is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
+*/
+
+#include "freetype.hh"
+#include "international.hh"
+#include "lily-guile.hh"
+#include "open-type-font.hh"
+#include "program-option.hh"
+#include "warn.hh"
+
+#include <cairo.h>
+#include <cairo-pdf.h>
+#include <cairo-ft.h>
+#include <map>
+#include <string>
+
+#define degToRad(ang) ((ang) * M_PI / 180.0)
+
+using std::string;
+using std::map;
+
+string lily_basename;
+double lily_output_units;
+double lily_output_scale;
+double lily_paper_height;
+double lily_paper_width;
+
+double sf;
+string cairo_pdf_filename;
+
+cairo_surface_t *surface;
+cairo_t *cr;
+
+struct lyfontdata {
+ FT_Face ftf;
+ cairo_font_face_t *cf;
+ double scale;
+};
+
+map<string,lyfontdata> fontmap = {};
+
+
+
+LY_DEFINE (ly_cairo_use_font, "ly:cairo-use-font",
+ 3, 0, 0, (SCM name, SCM file, SCM index),
+ "CAIRO: Use font name from file with index.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_string, name, 1);
+ LY_ASSERT_TYPE (scm_is_string, file, 2);
+ string fn = ly_scm2string (name);
+ string fi = ly_scm2string (file);
+ int ix = 0;
+ if (scm_is_integer (index))
+ ix = from_scm<int> (index);
+ debug_output (_f ("cairo-use-font: name: %s, file: %s, index: %d", fn.c_str(), fi.c_str(), ix));
+ map<string,lyfontdata>::iterator itfm = fontmap.find(fn);
+ if (itfm == fontmap.end()) {
+ cairo_user_data_key_t key;
+ FT_Face ft_face = open_ft_face (fi,ix);
+ if (!FT_HAS_GLYPH_NAMES(ft_face))
+ error (_f ("Font '%s' from file '%s' does not have a glyph name table!",fn,fi));
+ cairo_font_face_t *font_face = cairo_ft_font_face_create_for_ft_face (ft_face, 0);
+ cairo_status_t status = cairo_font_face_set_user_data (font_face, &key, ft_face, (cairo_destroy_func_t) FT_Done_Face);
+ if (status) {
+ cairo_font_face_destroy (font_face);
+ FT_Done_Face (ft_face);
+ error (_f ("Cannot use font '%s' from file '%s'", fn, fi));
+ }
+ fontmap.insert(make_pair(fn, (lyfontdata) {ft_face, font_face, -1.0}));
+ debug_output (_f(" inserted font %s loaded from %s in fontmap",fn, fi));
+ }
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_def_scaled_font, "ly:cairo-def-scaled-font",
+ 3, 0, 0, (SCM scaledname, SCM fontname, SCM scaling),
+ "CAIRO: Define scaledname as name for font fontname scaled size scaling."
+ " Has to be used after ly:cairo-use-font.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_string, scaledname, 1);
+ LY_ASSERT_TYPE (scm_is_string, fontname, 2);
+ LY_ASSERT_TYPE (scm_is_real, scaling, 3);
+ string sn = ly_scm2string (scaledname);
+ string fn = ly_scm2string (fontname);
+ double scalefac = from_scm<Real> (scaling);
+ debug_output (_f ("cairo-def-scaled-font: scaledname: %s, fontname: %s, scaling: %f", sn.c_str(), fn.c_str(), scalefac));
+ map<string,lyfontdata>::iterator itsn = fontmap.find(sn);
+ map<string,lyfontdata>::iterator itfn = fontmap.find(fn);
+ // abort if fontname is unknown
+ if (itfn == fontmap.end())
+ error (_f ("ly:cairo-def-scaled-font: execute ly:cairo-use-font before you try to scale a font!"));
+ else if (itsn == fontmap.end())
+ fontmap.insert (make_pair(sn, (lyfontdata) {itfn->second.ftf, itfn->second.cf, scalefac}));
+ // no else, ignore request if scaledname is already defined,
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_show_named_glyph, "ly:cairo-show-named-glyph",
+ 2, 0, 0, (SCM scaledname, SCM glyphname),
+ "CAIRO: show a named glyph of a scaled font.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_string, scaledname, 1);
+ LY_ASSERT_TYPE (scm_is_string, glyphname, 2);
+ string sn = ly_scm2string (scaledname);
+ string g = ly_scm2string (glyphname);
+ debug_output (_f ("show_named_glyph: scaledfont: %s glyph: %s",sn.c_str(), g.c_str()));
+ map<string,lyfontdata>::iterator itfm = fontmap.find(sn);
+ if (itfm == fontmap.end())
+ error (_f("ly:cairo-show-named-glyph: font %s has not been opened.",sn.c_str()));
+ if (itfm->second.scale < 0.0)
+ error (_f("ly:cairo-show-named-glyph: font %s is not known as a scaled font.",sn.c_str()));
+ cairo_set_font_face(cr,itfm->second.cf);
+ cairo_set_font_size(cr,itfm->second.scale * lily_output_units);
+ double cx, cy;
+ cairo_get_current_point(cr,&cx, &cy);
+ cairo_glyph_t oneglyph = {FT_Get_Name_Index(itfm->second.ftf,g.c_str()), cx, cy};
+ cairo_show_glyphs (cr,&oneglyph,1);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_print_glyphs, "ly:cairo-print-glyphs",
+ 4, 0, 0, (SCM fontname, SCM size, SCM count, SCM glyphs),
+ "CAIRO: equivalent of our postscript procedure print_glyphs.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_string, fontname, 1);
+ LY_ASSERT_TYPE (scm_is_real, size, 2);
+ LY_ASSERT_TYPE (scm_is_integer, count, 3);
+ string fn = ly_scm2string (fontname);
+ double sz = from_scm<Real> (size);
+ double sumw = 0.0;
+ double startx, starty;
+ cairo_get_current_point(cr,&startx, &starty);
+ int n = from_scm<int> (count);
+ debug_output (_f ("print_glyphs font: %s, size: %.12f, glyph count: %d", fn.c_str(), sz, n));
+ map<string,lyfontdata>::iterator itfm = fontmap.find(fn);
+ if (itfm != fontmap.end())
+ cairo_set_font_face(cr,itfm->second.cf);
+ else
+ error (_f("ly:cairo-print-glyphs detected that font %s has not been opened.",fn.c_str()));
+ cairo_set_font_size(cr,sz * lily_output_units);
+ for(int i=0;i<n;i++) {
+ auto wxyg = scm_list_ref(glyphs,to_scm(i));
+ double w = from_scm<Real>(scm_car(wxyg));
+ double x = from_scm<Real>(scm_cadr(wxyg));
+ double y = from_scm<Real>(scm_caddr(wxyg));
+ string g = ly_scm2string(scm_cadddr(wxyg));
+ cairo_glyph_t oneglyph = {FT_Get_Name_Index(itfm->second.ftf,g.c_str()),startx + (x + sumw)*sf, starty-y*sf};
+ cairo_show_glyphs (cr,&oneglyph,1);
+ sumw = sumw + w;
+ }
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_path, "ly:cairo-path",
+ 2, 3, 0, (SCM thickness, SCM exps, SCM cap, SCM join, SCM filled),
+ "Cairo: draw a path. Accept the moveto, rmoveto lineto, rlineto, curveto, rcurveto and closepath postscript "
+ "operators with the required number of arguments. ")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, thickness, 1);
+ LY_ASSERT_TYPE (scm_is_pair, exps, 2);
+ // Set linewidth
+ double blot = from_scm<Real> (thickness);
+ cairo_set_line_width(cr,sf * blot);
+ // Set line-caps-style, default to 'round
+ if (!SCM_UNBNDP (cap)) {
+ if (scm_is_eq (cap, ly_symbol2scm ("butt")))
+ cairo_set_line_cap(cr,CAIRO_LINE_CAP_BUTT);
+ else if (scm_is_eq (cap, ly_symbol2scm ("square")))
+ cairo_set_line_cap(cr,CAIRO_LINE_CAP_SQUARE);
+ } else
+ cairo_set_line_cap(cr,CAIRO_LINE_CAP_ROUND);
+ // Set line-join-style, default to 'round
+ if (!SCM_UNBNDP (join)) {
+ if (scm_is_eq (join, ly_symbol2scm ("miter")))
+ cairo_set_line_join(cr,CAIRO_LINE_JOIN_MITER);
+ else if (scm_is_eq (join, ly_symbol2scm ("bevel")))
+ cairo_set_line_join(cr,CAIRO_LINE_JOIN_BEVEL);
+ } else
+ cairo_set_line_join(cr,CAIRO_LINE_JOIN_ROUND);
+ // save to be able to undo cairo_translate
+ cairo_save(cr);
+ // translate: current point is new cairo origin
+ double cpx, cpy;
+ cairo_get_current_point(cr,&cpx, &cpy);
+ cairo_translate(cr,cpx,cpy);
+ // evaluate drawing primitives given in exps
+ for (;scm_is_pair (exps); exps = scm_cdr (exps)) {
+ SCM head = scm_car (exps);
+ if (scm_is_symbol (head)) {
+ if (scm_is_eq (head, ly_symbol2scm ("moveto"))) {
+ debug_output(_f("PATH: moveto"));
+ cairo_move_to(cr,
+ sf*from_scm<Real> (scm_list_ref(exps,to_scm(1))),
+ -sf*from_scm<Real> (scm_list_ref(exps,to_scm(2))));
+ } else if (scm_is_eq (head, ly_symbol2scm ("rmoveto"))){
+ debug_output(_f("PATH: rmoveto"));
+ cairo_rel_move_to(cr,
+ sf*from_scm<Real> (scm_list_ref(exps,to_scm(1))),
+ -sf*from_scm<Real> (scm_list_ref(exps,to_scm(2))));
+ } else if (scm_is_eq (head, ly_symbol2scm ("lineto"))){
+ debug_output(_f("PATH: lineto"));
+ cairo_line_to(cr,
+ sf*from_scm<Real> (scm_list_ref(exps,to_scm(1))),
+ -sf*from_scm<Real> (scm_list_ref(exps,to_scm(2))));
+ } else if (scm_is_eq (head, ly_symbol2scm ("rlineto"))){
+ debug_output(_f("PATH: rlineto"));
+ cairo_rel_line_to(cr,
+ sf*from_scm<Real> (scm_list_ref(exps,to_scm(1))),
+ -sf*from_scm<Real> (scm_list_ref(exps,to_scm(2))));
+ } else if (scm_is_eq (head, ly_symbol2scm ("curveto"))){
+ debug_output(_f("PATH: curveto"));
+ cairo_curve_to(cr,
+ sf*from_scm<Real> (scm_list_ref(exps,to_scm(1))),
+ -sf*from_scm<Real> (scm_list_ref(exps,to_scm(2))),
+ sf*from_scm<Real> (scm_list_ref(exps,to_scm(3))),
+ -sf*from_scm<Real> (scm_list_ref(exps,to_scm(4))),
+ sf*from_scm<Real> (scm_list_ref(exps,to_scm(5))),
+ -sf*from_scm<Real> (scm_list_ref(exps,to_scm(6))));
+ } else if (scm_is_eq (head, ly_symbol2scm ("rcurveto"))){
+ debug_output(_f("PATH: rcurveto"));
+ cairo_rel_curve_to(cr,
+ sf*from_scm<Real> (scm_list_ref(exps,to_scm(1))),
+ -sf*from_scm<Real> (scm_list_ref(exps,to_scm(2))),
+ sf*from_scm<Real> (scm_list_ref(exps,to_scm(3))),
+ -sf*from_scm<Real> (scm_list_ref(exps,to_scm(4))),
+ sf*from_scm<Real> (scm_list_ref(exps,to_scm(5))),
+ -sf*from_scm<Real> (scm_list_ref(exps,to_scm(6))));
+ } else if (scm_is_eq (head, ly_symbol2scm ("closepath"))){
+ debug_output(_f("PATH: closepath"));
+ cairo_close_path(cr);
+ } else {
+ error(_f("PATH: Unexpected postscript operator! "));
+ }
+ }
+ }
+ // stroke / fill according to user wishes
+ bool fill = false;
+ if (!SCM_UNBNDP (filled)) {
+ LY_ASSERT_TYPE (scm_is_bool, filled, 5);
+ fill = from_scm<bool> (filled);
+ }
+ if (!fill)
+ cairo_stroke(cr);
+ else if (blot > 0.0) {
+ cairo_stroke_preserve(cr);
+ cairo_fill(cr);
+ }
+ else
+ cairo_fill(cr);
+ // undo cr->translate
+ cairo_restore(cr);
+ //
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_showpage, "ly:cairo-showpage",
+ 0, 0, 0, (),
+ "CAIRO: equivalent of the postscript primitive showpage.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ debug_output (_f ("showpage"));
+ cairo_show_page(cr);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_restore, "ly:cairo-restore",
+ 0, 0, 0, (),
+ "CAIRO: equivalent of the postscript primitive restore.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ debug_output (_f ("restore"));
+ cairo_restore(cr);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_save, "ly:cairo-save",
+ 0, 0, 0, (),
+ "CAIRO: equivalent of the postscript primitive save.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ debug_output (_f ("save"));
+ cairo_save(cr);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_moveto, "ly:cairo-moveto",
+ 2, 0, 0, (SCM varx, SCM vary),
+ "CAIRO: equivalent of the postscript primitive moveto.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, varx, 1);
+ LY_ASSERT_TYPE (scm_is_real, vary, 2);
+ double x=from_scm<Real> (varx);
+ double y=from_scm<Real> (vary);
+ debug_output (_f ("moveto x: %f y: %f", x, y));
+ cairo_move_to(cr,x*sf,-y*sf);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_set_basename, "ly:cairo-set-basename",
+ 1, 0, 0, (SCM str),
+ "CAIRO: set lily-basename.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_string, str, 1);
+ lily_basename = ly_scm2string (str);
+ cairo_pdf_filename = lily_basename + ".cairo.pdf";
+ debug_output (_f ("set-basename: %s",lily_basename));
+ debug_output (_f ("cairo_pdf_filename is %s",cairo_pdf_filename));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_set_lily_output_units, "ly:cairo-set-lily-output-units",
+ 1, 0, 0, (SCM val),
+ "CAIRO: set lily-output-units.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, val, 1);
+ lily_output_units = from_scm<Real> (val);
+ sf = lily_output_units * lily_output_scale;
+ debug_output (_f ("set-lily-output-units: %f, sf: %f",lily_output_units, sf));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_set_output_scale, "ly:cairo-set-output-scale",
+ 1, 0, 0, (SCM val),
+ "CAIRO: set output-scale.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, val, 1);
+ lily_output_scale = from_scm<Real> (val);
+ sf = lily_output_units * lily_output_scale;
+ debug_output (_f ("set-output-scale: %f sf: %f",lily_output_scale, sf));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_set_paper_height, "ly:cairo-set-paper-height",
+ 1, 0, 0, (SCM val),
+ "CAIRO: set paper-height.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, val, 1);
+ lily_paper_height = from_scm<Real> (val);
+ debug_output (_f("CAIRO: Starting pdf, creating the surface."));
+ debug_output (_f ("set-paper-height: %f",lily_paper_height));
+ // This assumes that lily_paper_height is set after lily_paper_width and pdf_file_name
+ surface = cairo_pdf_surface_create(cairo_pdf_filename.c_str(), lily_paper_width, lily_paper_height);
+ cr = cairo_create(surface);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_set_paper_width, "ly:cairo-set-paper-width",
+ 1, 0, 0, (SCM val),
+ "CAIRO: set paper-width.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, val, 1);
+ lily_paper_width = from_scm<Real> (val);
+ debug_output (_f ("set-paper-width: %f",lily_paper_width));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_setrgbacolor, "ly:cairo-setrgbacolor",
+ 4, 0, 0, (SCM varr, SCM varg, SCM varb, SCM vara),
+ "CAIRO equivalent of our postscript procedure setrgbacolor"
+ " defined in music-drawing-routines.ps.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, varr, 1);
+ LY_ASSERT_TYPE (scm_is_real, varg, 2);
+ LY_ASSERT_TYPE (scm_is_real, varb, 3);
+ LY_ASSERT_TYPE (scm_is_real, vara, 4);
+ double r = from_scm<Real> (varr);
+ double g = from_scm<Real> (varg);
+ double b = from_scm<Real> (varb);
+ double a = from_scm<Real> (vara);
+ cairo_save(cr);
+ cairo_set_source_rgba(cr,r, g, b, a);
+ debug_output (_f ("setrgbacolor r:%f g:%f b:%f a:%f", r, g, b, a));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_resetrgbacolor, "ly:cairo-resetrgbacolor",
+ 0, 0, 0, (),
+ "CAIRO equivalent of our postscript procedure resetrgbacolor"
+ " defined in music-drawing-routines.ps.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ cairo_restore(cr);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_draw_line, "ly:cairo-draw-line",
+ 5, 0, 0, (SCM vardx, SCM vardy, SCM varx, SCM vary, SCM blotdiam),
+ "CAIRO equivalent of our postscript procedure draw_line"
+ " defined in music-drawing-routines.ps.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, vardx, 1);
+ LY_ASSERT_TYPE (scm_is_real, vardy, 2);
+ LY_ASSERT_TYPE (scm_is_real, varx, 3);
+ LY_ASSERT_TYPE (scm_is_real, vary, 4);
+ LY_ASSERT_TYPE (scm_is_real, blotdiam, 5);
+ double dx=from_scm<Real> (vardx);
+ double dy=from_scm<Real> (vardy);
+ double x=from_scm<Real> (varx);
+ double y=from_scm<Real> (vary);
+ double d=from_scm<Real> (blotdiam);
+ cairo_set_line_width(cr,d*sf);
+ cairo_set_line_cap(cr,CAIRO_LINE_CAP_ROUND);
+ cairo_rel_move_to(cr,x*sf,-y*sf);
+ cairo_rel_line_to(cr,dx*sf,-dy*sf);
+ cairo_stroke(cr);
+ debug_output (_f ("draw_line dx:%f dy:%f x:%f y:%f blotdiam:%f",
+ from_scm<Real> (vardx), from_scm<Real> (vardy), from_scm<Real> (varx),
+ from_scm<Real> (vary), from_scm<Real> (blotdiam)));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_draw_dashed_line, "ly:cairo-draw-dashed-line",
+ 6, 0, 0, (SCM vardx, SCM vardy, SCM blotdiam, SCM paton, SCM patoff, SCM phase),
+ "CAIRO equivalent of our postscript procedure dashed_line"
+ " defined in music-drawing-routines.ps.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, vardx, 1);
+ LY_ASSERT_TYPE (scm_is_real, vardy, 2);
+ LY_ASSERT_TYPE (scm_is_real, blotdiam, 3);
+ LY_ASSERT_TYPE (scm_is_real, paton, 4);
+ LY_ASSERT_TYPE (scm_is_real, patoff, 5);
+ LY_ASSERT_TYPE (scm_is_real, phase, 6);
+ double dx=from_scm<Real> (vardx);
+ double dy=from_scm<Real> (vardy);
+ double d=from_scm<Real> (blotdiam);
+ double on=from_scm<Real> (paton);
+ double off=from_scm<Real> (patoff);
+ double pha=from_scm<Real> (phase);
+ double pat[] = {on*sf, off*sf};
+ cairo_save(cr);
+ cairo_set_dash (cr,pat,2,pha*sf);
+ cairo_set_line_width(cr,d*sf);
+ cairo_set_line_cap(cr,CAIRO_LINE_CAP_ROUND);
+ cairo_rel_line_to(cr,dx*sf,-dy*sf);
+ cairo_stroke(cr);
+ cairo_restore(cr);
+ debug_output (_f ("draw-dashed-line dx:%f dy:%f on:%f off:%f phase:%f blotdiam:%f",
+ dx, dy, on, off, pha, d ));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_draw_round_box, "ly:cairo-draw-round-box",
+ 5, 0, 0, (SCM width, SCM height, SCM varx, SCM vary, SCM blotdiam),
+ "CAIRO equivalent of our postscript procedure draw_round_box"
+ " defined in music-drawing-routines.ps.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, width, 1);
+ LY_ASSERT_TYPE (scm_is_real, height, 2);
+ LY_ASSERT_TYPE (scm_is_real, varx, 3);
+ LY_ASSERT_TYPE (scm_is_real, vary, 4);
+ LY_ASSERT_TYPE (scm_is_real, blotdiam, 5);
+ double w=from_scm<Real> (width);
+ double h=from_scm<Real> (height);
+ double x=from_scm<Real> (varx);
+ double y=from_scm<Real> (vary);
+ double d=from_scm<Real> (blotdiam);
+ double r = d / 2;
+ debug_output (_f ("draw_round_box width:%f height:%f x:%f y:%f blotdiam:%f", w, h, x, y, d));
+ // FIXME correct but inefficient code (pdfs are bigger than necessary)
+ // possible optimizations: see ps code in music-drawing-routines.ps
+ if (r == 0) {
+ cairo_rel_move_to(cr,x*sf,-y*sf);
+ cairo_rel_line_to(cr,0,-h*sf);
+ cairo_rel_line_to(cr,w*sf,0);
+ cairo_rel_line_to(cr,0,h*sf);
+ cairo_rel_line_to(cr,-w*sf,0);
+ cairo_close_path(cr);
+ cairo_fill(cr);
+ } else {
+ double cx, cy;
+ cairo_rel_move_to(cr,x*sf, -y*sf);
+ cairo_get_current_point(cr,&cx, &cy);
+ cairo_new_sub_path(cr);
+ cairo_arc(cr,cx+w*sf,cy-h*sf,r*sf,degToRad(-90),degToRad(0));
+ cairo_arc(cr,cx+w*sf,cy,r*sf,degToRad(0),degToRad(90));
+ cairo_arc(cr,cx,cy,r*sf,degToRad(90),degToRad(180));
+ cairo_arc(cr,cx,cy-h*sf,r*sf,degToRad(180),degToRad(270));
+ cairo_close_path(cr);
+ cairo_fill(cr);
+ }
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_draw_polygon, "ly:cairo-draw-polygon",
+ 4, 0, 0, (SCM count, SCM points, SCM linewidth, SCM filled),
+ "CAIRO: equivalent of our postscript procedure draw_polygon.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_integer, count, 1);
+ LY_ASSERT_TYPE (scm_is_real, linewidth, 3);
+ LY_ASSERT_TYPE (scm_is_bool, filled, 4);
+ int n = from_scm<int> (count);
+ double blot = from_scm<Real> (linewidth);
+ bool fill = from_scm<bool> (filled);
+ debug_output(_f ("draw_polygon: %s, linewidth %f, points: %d", fill?"filled":"outline", blot, n));
+ double cx, cy, x, y;
+ cairo_get_current_point(cr,&cx, &cy);
+ cairo_set_line_width(cr,blot*sf);
+ cairo_set_line_cap(cr,CAIRO_LINE_CAP_BUTT);
+ cairo_set_line_join(cr,CAIRO_LINE_JOIN_ROUND);
+ for (int i=0; i<n; i++) {
+ x = from_scm<Real> (scm_list_ref(points,to_scm(i*2)));
+ y = from_scm<Real> (scm_list_ref(points,to_scm(i*2+1)));
+ debug_output(_f("point %d: x=%f, y=%f", i+1, x, y));
+ if (i==0)
+ cairo_move_to(cr,x*sf+cx,-y*sf+cy);
+ else
+ cairo_line_to(cr,x*sf+cx,-y*sf+cy);
+ }
+ cairo_close_path(cr);
+ if (fill) {
+ cairo_stroke_preserve(cr);
+ cairo_fill(cr);
+ } else
+ cairo_stroke(cr);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_draw_circle, "ly:cairo-draw-circle",
+ 3, 0, 0, (SCM radius, SCM thickness, SCM filled),
+ "CAIRO: equivalent of our postscript procedure draw_circle.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, radius, 1);
+ LY_ASSERT_TYPE (scm_is_real, thickness, 2);
+ LY_ASSERT_TYPE (scm_is_bool, filled, 3);
+ bool fill = from_scm<bool> (filled);
+ double rad = from_scm<Real> (radius);
+ double blot = from_scm<Real> (thickness);
+ double cx, cy;
+ cairo_get_current_point(cr,&cx, &cy);
+ cairo_set_line_width(cr,blot*sf);
+ cairo_new_sub_path(cr);
+ cairo_arc (cr,cx,cy,rad*sf, 0.0, degToRad(360));
+ if (fill) {
+ cairo_stroke_preserve(cr);
+ cairo_fill(cr);
+ } else
+ cairo_stroke(cr);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_draw_ellipse, "ly:cairo-draw-ellipse",
+ 4, 0, 0, (SCM xradius, SCM yradius, SCM thickness, SCM filled),
+ "CAIRO: equivalent of our postscript procedure draw_ellipse.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, xradius, 1);
+ LY_ASSERT_TYPE (scm_is_real, yradius, 2);
+ LY_ASSERT_TYPE (scm_is_real, thickness, 3);
+ LY_ASSERT_TYPE (scm_is_bool, filled, 4);
+ double xrad = from_scm<Real> (xradius);
+ double yrad = from_scm<Real> (yradius);
+ double blot = from_scm<Real> (thickness);
+ bool fill = from_scm<bool> (filled);
+ double cx, cy;
+ cairo_save(cr);
+ cairo_get_current_point(cr,&cx, &cy);
+ cairo_translate(cr,cx,cy);
+ cairo_scale(cr,1,yrad/xrad);
+ cairo_new_path(cr);
+ cairo_arc(cr,0,0,xrad*sf,0,degToRad(360));
+ cairo_restore(cr);
+ cairo_set_line_width(cr,blot*sf);
+ if (fill) {
+ cairo_stroke_preserve(cr);
+ cairo_fill(cr);
+ } else
+ cairo_stroke(cr);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_draw_partial_ellipse, "ly:cairo-draw-partial-ellipse",
+ 7, 0, 0, (SCM xradius, SCM yradius, SCM startangle, SCM endangle, SCM thickness, SCM connected, SCM filled),
+ "CAIRO: equivalent of our postscript procedure draw_partial_ellipse.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, xradius, 1);
+ LY_ASSERT_TYPE (scm_is_real, yradius, 2);
+ LY_ASSERT_TYPE (scm_is_real, startangle, 3);
+ LY_ASSERT_TYPE (scm_is_real, endangle, 4);
+ LY_ASSERT_TYPE (scm_is_real, thickness, 5);
+ LY_ASSERT_TYPE (scm_is_bool, connected, 6);
+ LY_ASSERT_TYPE (scm_is_bool, filled, 7);
+ double xrad = from_scm<Real> (xradius);
+ double yrad = from_scm<Real> (yradius);
+ double sang = from_scm<Real> (startangle);
+ double eang = from_scm<Real> (endangle);
+ double blot = from_scm<Real> (thickness);
+ bool conn = from_scm<bool> (connected);
+ bool fill = from_scm<bool> (filled);
+ double cx, cy;
+ cairo_save(cr);
+ cairo_get_current_point(cr,&cx, &cy);
+ cairo_translate(cr,cx,cy);
+ cairo_scale(cr,1,yrad/xrad);
+ cairo_new_path(cr);
+ cairo_arc(cr,0,0,xrad*sf,degToRad(-eang),degToRad(-sang));
+ if (conn)
+ cairo_close_path(cr);
+ cairo_restore(cr);
+ cairo_set_line_width(cr,blot*sf);
+ if (fill) {
+ cairo_stroke_preserve(cr);
+ cairo_fill(cr);
+ } else
+ cairo_stroke(cr);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_set_rotation, "ly:cairo-set-rotation",
+ 3, 0, 0, (SCM angle, SCM varx, SCM vary),
+ "CAIRO: equivalent of setrotation.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, angle, 1);
+ LY_ASSERT_TYPE (scm_is_real, varx, 2);
+ LY_ASSERT_TYPE (scm_is_real, vary, 3);
+ double ang = from_scm<Real> (angle);
+ double x = from_scm<Real> (varx);
+ double y = from_scm<Real> (vary);
+ debug_output(_f("set_rotation angle:%f, x:%f, y%f", ang, x, y));
+ cairo_save(cr);
+ cairo_translate(cr,x*sf,-y*sf);
+ cairo_rotate(cr,degToRad(-ang));
+ cairo_translate(cr,-x*sf,y*sf);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_reset_rotation, "ly:cairo-reset-rotation",
+ 3, 0, 0, (SCM angle, SCM varx, SCM vary),
+ "CAIRO: equivalent of resetrotation.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, angle, 1);
+ LY_ASSERT_TYPE (scm_is_real, varx, 2);
+ LY_ASSERT_TYPE (scm_is_real, vary, 3);
+ double ang = from_scm<Real> (angle);
+ double x = from_scm<Real> (varx);
+ double y = from_scm<Real> (vary);
+ debug_output(_f("reset_rotation angle:%f, x:%f, y%f", ang, x, y));
+ cairo_restore(cr);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_url_link, "ly:cairo-url-link",
+ 3, 0, 0, (SCM target, SCM varx, SCM vary),
+ "CAIRO: Add an URL link.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_string, target, 1);
+ LY_ASSERT_TYPE (scm_is_pair, varx, 2);
+ LY_ASSERT_TYPE (scm_is_pair, vary, 3);
+ string url = ly_scm2string (target);
+ double x = from_scm<Real>(scm_car (varx));
+ double y = from_scm<Real>(scm_car (vary));
+ double w = from_scm<Real>(scm_cdr (varx)) - x;
+ double h = y - from_scm<Real>(scm_cdr (vary));
+ double cx, cy;
+ cairo_get_current_point(cr,&cx, &cy);
+ string attr = "rect=[ " + std::to_string (cx + x*sf) + " " + std::to_string (cy - y*sf) + " "
+ + std::to_string (w*sf) + " " + std::to_string (h*sf) + " ] uri='" + url + "'";
+ cairo_tag_begin (cr, CAIRO_TAG_LINK, attr.c_str());
+ cairo_tag_end (cr, CAIRO_TAG_LINK);
+ debug_output(_f("url-link %s",attr.c_str()));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_textedit_link, "ly:cairo-textedit-link",
+ 8, 0, 0, (SCM llx, SCM lly, SCM urx, SCM ury, SCM uri, SCM line, SCM scol, SCM ecol),
+ "CAIRO: Add a textedit link.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, llx, 1);
+ LY_ASSERT_TYPE (scm_is_real, lly, 2);
+ LY_ASSERT_TYPE (scm_is_real, urx, 3);
+ LY_ASSERT_TYPE (scm_is_real, ury, 4);
+ LY_ASSERT_TYPE (scm_is_string, uri, 5);
+ LY_ASSERT_TYPE (scm_is_integer, line, 6);
+ LY_ASSERT_TYPE (scm_is_integer, scol, 7);
+ LY_ASSERT_TYPE (scm_is_integer, ecol, 8);
+ string file = ly_scm2string (uri);
+ double x = from_scm<Real>(llx);
+ double y = from_scm<Real>(lly);
+ double w = from_scm<Real>(urx) - x;
+ double h = y - from_scm<Real>(ury);
+ int l = from_scm<int>(line);
+ int sc = from_scm<int>(scol);
+ int ec = from_scm<int>(ecol);
+ string attr = "rect=[ " + std::to_string (x*sf) + " " + std::to_string (- y*sf) + " "
+ + std::to_string (w*sf) + " " + std::to_string (h*sf) + " ] uri='textedit://" + file
+ + ":" + std::to_string (l) + ":" + std::to_string (sc) + ":" + std::to_string (ec) + "'";
+ cairo_tag_begin (cr, CAIRO_TAG_LINK, attr.c_str());
+ cairo_tag_end (cr, CAIRO_TAG_LINK);
+ debug_output(_f("textedit-link %s",attr.c_str()));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+// FIXME Links to pages that already have been generated work fine,
+// links with forward references do _not_ work in cairo 1.16.
+// This is either a documentation flaw or a cairo bug. Maybe a named
+// destination can be used? I'll have to investigate that.
+//
+LY_DEFINE (ly_cairo_page_link, "ly:cairo-page-link",
+ 3, 0, 0, (SCM target, SCM varx, SCM vary),
+ "CAIRO: Add a page link.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_integer, target, 1);
+ LY_ASSERT_TYPE (scm_is_pair, varx, 2);
+ LY_ASSERT_TYPE (scm_is_pair, vary, 3);
+ int page = from_scm<int>(target);
+ double x = from_scm<Real>(scm_car (varx));
+ double y = from_scm<Real>(scm_car (vary));
+ double w = from_scm<Real>(scm_cdr (varx)) - x;
+ double h = y - from_scm<Real>(scm_cdr (vary));
+ double cx, cy;
+ cairo_get_current_point(cr,&cx, &cy);
+ string attr = "rect=[ " + std::to_string (cx + x*sf) + " " + std::to_string (cy - y*sf) + " "
+ + std::to_string (w*sf) + " " + std::to_string (h*sf) + " ] page=" + std::to_string (page) + " pos=[0.0 0.0]";
+ cairo_tag_begin (cr, CAIRO_TAG_LINK, attr.c_str());
+ cairo_tag_end (cr, CAIRO_TAG_LINK);
+ debug_output(_f("page-link %s",attr.c_str()));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_set_scale, "ly:cairo-set-scale",
+ 2, 0, 0, (SCM varx, SCM vary),
+ "CAIRO: equivalent of setscale.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_real, varx, 1);
+ LY_ASSERT_TYPE (scm_is_real, vary, 2);
+ double x = from_scm<Real> (varx);
+ double y = from_scm<Real> (vary);
+ debug_output(_f("set_scale: x:%f, y%f", x, y));
+ cairo_save(cr);
+ cairo_scale(cr,x,y);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_reset_scale, "ly:cairo-reset-scale",
+ 0, 0, 0, (),
+ "CAIRO: equivalent of resetscale.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ debug_output(_f("reset_scale"));
+ cairo_restore(cr);
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_unknown, "ly:cairo-unknown",
+ 0, 0, 0, (),
+ "CAIRO: detect stencil command 'unknown' and print a warning.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ warning(_f("stencil command 'unknown'!"));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_no_origin, "ly:cairo-no-origin",
+ 0, 0, 0, (),
+ "CAIRO: detect stencil command 'no-origin' and print a warning.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ debug_output(_f("stencil command 'no-origin'!"));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_reset_grob_cause, "ly:cairo-reset-grob-cause",
+ 0, 0, 0, (),
+ "CAIRO: detect stencil command 'reset-grob-cause' and print a warning.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ warning(_f("stencil command 'reset-grob-cause'"));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_char, "ly:cairo-char",
+ 2, 0, 0, (SCM font, SCM i),
+ "CAIRO: detect stencil command 'char' and print a warning.")
+
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_string, font, 1);
+ LY_ASSERT_TYPE (scm_is_integer, i, 2);
+ string fn = ly_scm2string (font);
+ warning(_f("stencil command 'char' detected, it tries to use font %s!", fn.c_str()));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_embedded_ps, "ly:cairo-embedded-ps",
+ 1, 0, 0, (SCM postscript),
+ "CAIRO: detect stencil command 'embedded-ps' and print a warning.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_string, postscript, 1);
+ string ps = ly_scm2string (postscript);
+ warning(_f("Cairo is unable to handle embedded postscript!\n"));
+ debug_output(_f("The embedded postscript code is: %s", ps.c_str()));
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_metadata, "ly:cairo-metadata",
+ 2, 0, 0, (SCM field, SCM value),
+ "Cairo: Pass metadata to pdf surface.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ LY_ASSERT_TYPE (scm_is_string, field, 1);
+ LY_ASSERT_TYPE (scm_is_string, value, 2);
+ string key = ly_scm2string (field);
+ string val = ly_scm2string (value);
+ if (key == "Author")
+ cairo_pdf_surface_set_metadata (surface,CAIRO_PDF_METADATA_AUTHOR,val.c_str());
+ else if (key == "Creator")
+ cairo_pdf_surface_set_metadata (surface,CAIRO_PDF_METADATA_CREATOR,val.c_str());
+ else if (key == "Keywords")
+ cairo_pdf_surface_set_metadata (surface,CAIRO_PDF_METADATA_KEYWORDS,val.c_str());
+ else if (key == "Subject")
+ cairo_pdf_surface_set_metadata (surface,CAIRO_PDF_METADATA_SUBJECT,val.c_str());
+ else if (key == "Title")
+ cairo_pdf_surface_set_metadata (surface,CAIRO_PDF_METADATA_TITLE,val.c_str());
+ return SCM_UNSPECIFIED;
+}
+
+
+
+LY_DEFINE (ly_cairo_at_eof, "ly:cairo-at-eof",
+ 0, 0, 0, (),
+ "CAIRO: Inform cairo to finalize the pdf and to clean up.")
+{
+ if (!from_scm<bool> (ly_get_option (ly_symbol2scm ("cairotest"))))
+ return SCM_UNSPECIFIED;
+ cairo_surface_destroy(surface);
+ cairo_destroy(cr);
+ debug_output(_f("CAIRO: Finished Pdf, cairo surface and context destroyed."));
+ return SCM_UNSPECIFIED;
+}
diff --git a/lily/main.cc b/lily/main.cc
index 5564222b35..ddbeefe59f 100644
--- a/lily/main.cc
+++ b/lily/main.cc
@@ -145,6 +145,10 @@ static Long_option_init options_static[]
0, "eps", 'E',
_i ("generate Encapsulated PostScript files")
},
+ {
+ 0, "cairotest", 'c',
+ _i ("generate a *.cairo.pdf test file")
+ },
{
_i ("KEY"), "pspdfopt", 'O',
_i ("set ps/pdf optimization to KEY, which is either\n"
@@ -679,6 +683,12 @@ parse_argv (int argc, char **argv)
}
break;
+ case 'c':
+ {
+ init_scheme_variables_global += "(cairotest . #t)\n";
+ }
+ break;
+
case 'd':
{
string arg (option_parser->optional_argument_str0_);
diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 18dc6a7166..6c8c01edba 100644
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -51,6 +51,7 @@
"")
(define (ps-define-font font font-name scaling)
+ (ly:cairo-def-scaled-font (ps-font-command font) font-name scaling)
(if (ly:get-option 'music-font-encodings)
(string-append
"/" (ps-font-command font) "-N"
@@ -87,6 +88,8 @@
"/" ps-key " "
(value->string (ly:output-def-lookup layout ly-key)) " def\n"))
+ (ly:cairo-set-lily-output-units (/ (ly:bp 1)))
+ (ly:cairo-set-output-scale (ly:output-def-lookup layout 'output-scale))
(string-append
"/lily-output-units "
(number->string (/ (ly:bp 1))) " def %% millimeter\n"
@@ -123,6 +126,7 @@
"gsave 0 paper-height translate set-ps-scale-to-lily-scale\n"))
(ly:outputter-dump-stencil outputter page-stencil)
(ly:outputter-dump-string outputter ".endtransparencygroup\n.poppdf14devicefilter\n")
+ (ly:cairo-showpage)
(ly:outputter-dump-string outputter "stroke grestore\nshowpage\n"))
(define (supplies-or-needs paper load-fonts?)
@@ -163,6 +167,8 @@
(ly:output-def-lookup paper 'output-scale))
(ly:bp 1)))
(landscape? (eq? (ly:output-def-lookup paper 'landscape) #t)))
+ (ly:cairo-set-paper-width (if landscape? h w))
+ (ly:cairo-set-paper-height (if landscape? w h))
(format #f "%%DocumentMedia: ~a ~,2f ~,2f ~a ~a ~a\n"
(ly:output-def-lookup paper 'papersizename)
(if landscape? h w)
@@ -362,6 +368,8 @@
(file-name (caddr font-name-filename))
(font-index (cadddr font-name-filename))
(bare-file-name (ly:find-file file-name)))
+ (if (not font) (ly:cairo-use-font name file-name font-index)
+ (ly:cairo-use-font name (ly:find-file (format #f "~a.otf" file-name)) font-index))
(cond
((and (number? font-index)
(!= font-index 0))
@@ -478,6 +486,8 @@
(file-name (list-ref font-psname-filename-fontindex 2))
(font-index (list-ref font-psname-filename-fontindex 3))
(bare-file-name (ly:find-file file-name)))
+ (if (not font) (ly:cairo-use-font name file-name font-index)
+ (ly:cairo-use-font name (ly:find-file (format #f "~a.otf" file-name)) font-index))
(cons name
(cond ((mac-font? bare-file-name)
(handle-mac-font name bare-file-name))
@@ -682,13 +692,16 @@
(fallbackval (ly:modules-lookup (list header) fallbackvar))
(val (if overrideval overrideval fallbackval)))
(if val
- (format port "/~a (~a)\n" field (metadata-encode (markup->string val (list header)))))))
+ (begin
+ (ly:cairo-metadata field (markup->string val (list header)))
+ (format port "/~a (~a)\n" field (metadata-encode (markup->string val (list header))))))))
(if (module? header)
(begin
(display "mark " port)
(metadata-lookup-output 'pdfauthor 'author "Author")
(format port "/Creator (LilyPond ~a)\n" (lilypond-version))
+ (ly:cairo-metadata "Creator" (string-append "LilyPond " (lilypond-version) " with experimental cairo patch"))
(metadata-lookup-output 'pdftitle 'title "Title")
(metadata-lookup-output 'pdfsubject 'subject "Subject")
(metadata-lookup-output 'pdfkeywords 'keywords "Keywords")
@@ -765,6 +778,7 @@ mark {ly~a_stream} /CLOSE pdfmark
(landscape? (eq? (ly:output-def-lookup paper 'landscape) #t))
(page-number (1- (ly:output-def-lookup paper 'first-page-number)))
(page-count (length page-stencils)))
+ (ly:cairo-set-basename basename)
(cond-expand
(guile-2 (set-port-encoding! port "Latin1"))
(else))
@@ -790,6 +804,7 @@ mark {ly~a_stream} /CLOSE pdfmark
(ly:output-def-lookup paper 'label-page-table)
port))
(display "%%Trailer\n%%EOF\n" port)
+ (ly:cairo-at-eof)
(ly:outputter-close outputter)
(postprocess-output book framework-ps-module (ly:output-formats)
basename tmp-name #f)))
diff --git a/scm/lily.scm b/scm/lily.scm
index 06760089f0..5b3f99f4ea 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -258,6 +258,8 @@ EPS backend.")
(backend ps
"Select backend. Possible values: 'eps, 'null,
'ps, 'scm, 'svg.")
+ (cairotest #f
+ "Also generate a .cairo.pdf file.")
(check-internal-types #f
"Check every property assignment for types.")
(clip-systems #f
diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index 3373108f8d..9b10ba2632 100644
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -37,12 +37,17 @@
;;; Lily output interface, PostScript implementation --- cleanup and docme
;;;
+;;
+;; Is this stencil command used? I don't think so ...
+;;
(define (char font i)
+ (ly:cairo-char font i)
(format #f "~a (\\~,8f) show\n"
(ps-font-command font)
i))
(define (circle radius thick fill)
+ (ly:cairo-draw-circle radius thick fill)
(ly:format
"~a ~4f ~4f draw_circle\n"
(if fill
@@ -51,6 +56,7 @@
radius thick))
(define (dashed-line thick on off dx dy phase)
+ (ly:cairo-draw-dashed-line dx dy thick on off phase)
(ly:format "~4f ~4f ~4f [ ~4f ~4f ] ~4f draw_dashed_line\n"
dx
dy
@@ -60,11 +66,13 @@
phase))
(define (draw-line thick x1 y1 x2 y2)
+ (ly:cairo-draw-line (- x2 x1) (- y2 y1) x1 y1 thick)
(ly:format "~4f ~4f ~4f ~4f ~4f draw_line\n"
(- x2 x1) (- y2 y1)
x1 y1 thick))
(define (partial-ellipse x-radius y-radius start-angle end-angle thick connect fill)
+ (ly:cairo-draw-partial-ellipse x-radius y-radius start-angle end-angle thick connect fill)
(ly:format "~a ~a ~4f ~4f ~4f ~4f ~4f draw_partial_ellipse\n"
(if fill "true" "false")
(if connect "true" "false")
@@ -75,6 +83,7 @@
thick))
(define (ellipse x-radius y-radius thick fill)
+ (ly:cairo-draw-ellipse x-radius y-radius thick fill)
(ly:format
"~a ~4f ~4f ~4f draw_ellipse\n"
(if fill
@@ -83,6 +92,7 @@
x-radius y-radius thick))
(define (embedded-ps string)
+ (ly:cairo-embedded-ps string)
string)
(define (glyph-string pango-font
@@ -97,6 +107,11 @@
(if (and (= x 0) (= y 0))
(ly:format "currentpoint ~a moveto ~4f 0 rmoveto" g w)
(ly:format "currentpoint ~4f ~4f rmoveto ~a moveto ~4f 0 rmoveto" x y g w)))
+ (define (cgs w h x y g) (list w x y g))
+ (ly:cairo-print-glyphs postscript-font-name size (length w-x-y-named-glyphs)
+ (map (lambda (x)
+ (apply cgs x))
+ w-x-y-named-glyphs))
(if cid?
(ly:format
"/~a /CIDFont findresource ~a output-scale div scalefont setfont\n~a\n~a print_glyphs\n"
@@ -140,25 +155,27 @@
(if (and (< 0 (interval-length x-ext))
(< 0 (interval-length y-ext)))
- (ly:format " ~4f ~4f ~4f ~4f (textedit://~a:~a:~a:~a) mark_URI\n"
- (+ (car offset) (car x-ext))
- (+ (cdr offset) (car y-ext))
- (+ (car offset) (cdr x-ext))
- (+ (cdr offset) (cdr y-ext))
-
- ;; Backslashes are not valid
- ;; file URI path separators.
- (ly:string-percent-encode
- (ly:string-substitute "\\" "/" file))
-
- (cadr location)
- (caddr location)
- (1+ (cadddr location)))
+ (let* ((llx (+ (car offset) (car x-ext)))
+ (lly (+ (cdr offset) (car y-ext)))
+ (urx (+ (car offset) (cdr x-ext)))
+ (ury (+ (cdr offset) (cdr y-ext)))
+ (uri (ly:string-percent-encode (ly:string-substitute "\\" "/" file)))
+ (line (cadr location))
+ (scol (caddr location))
+ (ecol (1+ (cadddr location))))
+ (ly:cairo-textedit-link llx lly urx ury uri line scol ecol)
+ (ly:format " ~4f ~4f ~4f ~4f (textedit://~a:~a:~a:~a) mark_URI\n"
+ llx lly urx ury uri line scol ecol ))
""))
""))
""))
+(define (reset-grob-cause)
+ (ly:cairo-reset-grob-cause)
+ "")
+
(define (named-glyph font glyph)
+ (ly:cairo-show-named-glyph (ps-font-command font) glyph)
(if (and (ly:get-option 'music-font-encodings) (string-startswith (ly:font-file-name font) "emmentaler"))
(if (string-endswith (ly:font-file-name font)"-brace")
(if (or (string-startswith glyph "brace1") (string-startswith glyph "brace2"))
@@ -174,12 +191,15 @@
(format #f "~a /~a glyphshow\n" (ps-font-command font) glyph)))
(define (no-origin)
+ (ly:cairo-no-origin)
"")
(define (settranslation x y)
+ (ly:cairo-moveto x y)
(ly:format " ~4f ~4f moveto\n" x y))
(define (polygon points blot-diameter filled?)
+ (ly:cairo-draw-polygon (/ (length points) 2) points blot-diameter filled?)
(ly:format "~a ~a ~a ~4f draw_polygon\n"
(if filled? "true" "false")
(string-join (map (lambda (p) (ly:format "~4f" p)) points) " ")
@@ -192,6 +212,7 @@
(width (- right (+ halfblot x)))
(y (- halfblot bottom))
(height (- top (+ halfblot y))))
+ (ly:cairo-draw-round-box width height x y blotdiam)
(ly:format "~4f ~4f ~4f ~4f ~4f draw_round_box\n"
width height x y blotdiam)))
@@ -203,25 +224,32 @@
(if a (list r g b a)
(list r g b))))
(colors (length colorlist)))
+ (ly:cairo-setrgbacolor r g b (if (= colors 3) 1.0 a))
(if (= colors 3)
(apply ly:format "gsave ~4f ~4f ~4f setrgbcolor\n" colorlist)
(apply ly:format "gsave ~4f ~4f ~4f ~4f setrgbacolor\n" colorlist))))
;; restore color from stack
-(define (resetcolor) "grestore\n")
+(define (resetcolor)
+ (ly:cairo-resetrgbacolor)
+ "grestore\n")
;; rotation around given point
(define (setrotation ang x y)
+ (ly:cairo-set-rotation ang x y)
(ly:format "gsave ~4f ~4f translate ~a rotate ~4f ~4f translate\n"
x y ang (- x) (- y)))
(define (resetrotation ang x y)
+ (ly:cairo-reset-rotation ang x y)
"grestore\n")
(define (unknown)
+ (ly:cairo-unknown)
"unknown\n")
(define (url-link url x y)
+ (ly:cairo-url-link url x y)
(ly:format "~a ~a currentpoint vector_add ~a ~a currentpoint vector_add (~a) mark_URI\n"
(car x)
(car y)
@@ -230,6 +258,7 @@
url))
(define (page-link page-no x y)
+ (ly:cairo-page-link page-no x y)
(if (number? page-no)
(ly:format "~a ~a currentpoint vector_add ~a ~a currentpoint vector_add ~a mark_page_link\n"
(car x)
@@ -261,6 +290,7 @@
(convert-path-exps (drop rest arity))))
'()))
+ (ly:cairo-path thickness exps cap join fill?)
(let ((cap-numeric (case cap ((butt) 0) ((round) 1) ((square) 2)
(else (begin
(ly:warning (_ "unknown line-cap-style: ~S")
@@ -286,9 +316,11 @@
(else "fill")))))
(define (setscale x y)
+ (ly:cairo-set-scale x y)
(ly:format "gsave ~4f ~4f scale\n" x y))
(define (resetscale)
+ (ly:cairo-reset-scale)
"grestore\n")
(define-public stencil-dispatch-alist
@@ -310,7 +342,7 @@
(resetcolor . ,resetcolor)
(setrotation . ,setrotation)
(resetrotation . ,resetrotation)
- (reset-grob-cause . ,no-origin)
+ (reset-grob-cause . ,reset-grob-cause)
(unknown . ,unknown)
(url-link . ,url-link)
(page-link . ,page-link)
--
2.31.1
\version "2.23.3"
\paper {
#(set-paper-size "a4")
top-margin = 10\mm
bottom-margin = 10\mm
left-margin = 10\mm
line-width = 190\mm
}
global = { \time 6/8 \key c \minor }
#(set-global-staff-size 19)
\header {
pdftitle = "Lilypond Stencil Tests"
author = "Dr. Fred MBogo"
subject = "Test all lilypond stencil commands that are relevant to PDF output"
keywords = "Lilypond, Cairo, experimental, patch, stencil command tests"
}
\bookpart{
\markup {
\center-column {
\abs-fontsize #132 \line { Lilypond } \vspace #1
\abs-fontsize #65 \line { \scale #'(-1 . 1) "stencil tests" } \vspace #1
\abs-fontsize #40 \line { \with-color #(x11-color 'red) \scale #'(1 . -1) "Lilypond stencil test page" } \vspace #1
\abs-fontsize #18 \line { "Lilypond stencil test page"
\concat {
\with-dimensions #'(0 . 0) #'(0 . 0)\with-color #(rgb-color 1.0 0.0 0.0 0.15)\draw-circle #45 #0 ##t
\with-dimensions #'(0 . 0) #'(0 . 0)\with-color #(rgb-color 0.8 0.0 0.2 0.15)\draw-circle #40 #0 ##t
\with-dimensions #'(0 . 0) #'(0 . 0)\with-color #(rgb-color 0.6 0.0 0.4 0.15)\draw-circle #35 #0 ##t
\with-dimensions #'(0 . 0) #'(0 . 0)\with-color #(rgb-color 0.4 0.0 0.6 0.15)\draw-circle #30 #0 ##t
\with-dimensions #'(0 . 0) #'(0 . 0)\with-color #(rgb-color 0.2 0.0 0.8 0.15)\draw-circle #25 #0 ##t
\with-dimensions #'(0 . 0) #'(0 . 0)\with-color #(rgb-color 0.0 0.0 1.0 0.15)\draw-circle #20 #0 ##t }
"Lilypond stencil test page" } \vspace #1
\line { \draw-circle #3 #0.5 ##f \hspace #2 \scale #'(2 . 1) \circle {Foobar} \hspace #2 \draw-circle #3 #0 ##t } \vspace #1
\line { \postscript " save restore "
\rotate #-40 \ellipse { Foobar } \hspace #2
\ellipse { "Dr. Fred MBogo" } \hspace #2
\rotate #20 \rotate #20 \oval {Foobar} } \vspace #1
\line {\rotate #-30 "-30" \rotate #0 "000"\rotate #30 "030" \rotate #60 "060"
\rotate #90 "090" \rotate #120 "120" \rotate #150 "150" \rotate #180 "180"
\rotate #210 "210" \rotate #240 "240" \rotate #270 "270" \rotate #300 "300"
\rotate #330 "330" \rotate #360 "360" \rotate #390 "390" } \vspace #1
\line { \page-link #2 \italic "This links to page 2..." } \vspace #1
\line { \woodwind-diagram #'bassoon #'()
\woodwind-diagram #'flute #'((cc . (one1q)) (lh . ()) (rh . ()))
\woodwind-diagram #'flute #'((cc . (one1h)) (lh . ()) (rh . ()))
\woodwind-diagram #'flute #'((cc . (one3q)) (lh . ()) (rh . ()))
\woodwind-diagram #'flute #'((cc . (oneR)) (lh . ()) (rh . ()))
\woodwind-diagram #'flute #'((cc . (oneF two)) (lh . ()) (rh . ())) } \vspace #1
\line { \override #'((on . 5.0) (off . 5.0) (phase . 0.0) (full-length . #f)) \draw-dashed-line #'(30 . 0)
\override #'((on . 1.0) (off . 0.5) (phase . 0.0) (full-length . #f)) \draw-dashed-line #'(30 . 0)
} \vspace #-0.95
\line { \override #'((on . 5.0) (off . 5.0) (phase . 5.0) (full-length . #f)) \draw-dashed-line #'(30 . 0)
\override #'((on . 1.0) (off . 0.5) (phase . .75) (full-length . #f)) \draw-dashed-line #'(30 . 0)
} \vspace #1
\line { "Test the textedit links in the score below ..." } \vspace #1
\score { <<
\new Staff \with { \magnifyStaff #2/3 }
\relative { \global \set Staff.instrumentName = "Violin" c'8.(\f^> b16 c d) ees8.(^> d16 c b) g8.(^> b16 c ees) g8-.^> r r R2. }
\new PianoStaff << \set PianoStaff.instrumentName = "Piano"
\new Staff \relative { \global s2. s4. s8 r8 r16 <c' f aes c> <c f aes c>4.^> <c ees g>8 r r }
\new Staff \relative { \global \clef "bass" <<
{ \once \override DynamicText.X-offset = #-3 <ees g c>2.~->^\f <ees g c>4.~ <ees g c>8 } \\
{ <c g c,>2.~ <c g c,>4.~ <c g c,>8 } >>
r8 r16 <f, c' aes'>16 <f c' aes'>4.-> <c' g'>8 r r
} >> >>
}
}
}
}
\bookpart {
\markup {
\center-column {
\fill-line { \page-link #1 \italic "This links to page 1..." }
\fill-line { \page-link #3 \italic "This links to page 3..." }
}
}
}
\bookpart {
\markup {
\center-column {
\fill-line { \page-link #2 \italic "This links to page 2..." }
}
}
}
