From 167dbf0b9730a336907db36be6add1895d29eaf8 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Thu, 10 Jun 2004 15:20:17 +0000 Subject: [PATCH] * scm/output-gnome.scm: Add font scaling. Attempt to resurrect gnome backend. * scm/framework-gnome.scm: New file. * scm/lily.scm: Use it. * lily/paper-outputter.cc: Janitorial cleanups. (ly:outputter-dump-string): Remove unreachable statement. * scm/framework-ps.scm: Add header. Janitorial cleanups. (ice-9): Bugfix: Add srfi-1. * scm/framework-tex.scm: Add header. Janitorial cleanups. --- ChangeLog | 17 ++++ lily/paper-outputter.cc | 56 ++++++------ scm/framework-gnome.scm | 33 +++++++ scm/framework-ps.scm | 168 ++++++++++++++++------------------ scm/framework-tex.scm | 195 +++++++++++++++++----------------------- scm/lily.scm | 9 +- scm/output-gnome.scm | 60 +++++++------ 7 files changed, 273 insertions(+), 265 deletions(-) create mode 100644 scm/framework-gnome.scm diff --git a/ChangeLog b/ChangeLog index 96341faaa5..c7fd8b9e59 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,20 @@ +2004-06-10 Jan Nieuwenhuizen + + * scm/output-gnome.scm: Add font scaling. Attempt to resurrect + gnome backend. + + * scm/framework-gnome.scm: New file. + + * scm/lily.scm: Use it. + + * lily/paper-outputter.cc: Janitorial cleanups. + (ly:outputter-dump-string): Remove unreachable statement. + + * scm/framework-ps.scm: Add header. Janitorial cleanups. + (ice-9): Bugfix: Add srfi-1. + + * scm/framework-tex.scm: Add header. Janitorial cleanups. + 2004-06-08 Han-Wen Nienhuys * lily/new-lyric-combine-music-iterator.cc (do_quit): put warning diff --git a/lily/paper-outputter.cc b/lily/paper-outputter.cc index 83f37e3b54..7affc64bb4 100644 --- a/lily/paper-outputter.cc +++ b/lily/paper-outputter.cc @@ -10,7 +10,6 @@ #include #include - #include "array.hh" #include "dimensions.hh" #include "font-metric.hh" @@ -30,10 +29,8 @@ #include "string-convert.hh" #include "warn.hh" -#include "ly-smobs.icc" - // JUNKME -extern SCM stencil2line (Stencil* stil, bool is_title = false); +extern SCM stencil2line (Stencil *stil, bool is_title = false); Paper_outputter::Paper_outputter (String filename, String format) { @@ -53,10 +50,15 @@ Paper_outputter::~Paper_outputter () { } +#include "ly-smobs.icc" + +IMPLEMENT_SMOBS (Paper_outputter); +IMPLEMENT_DEFAULT_EQUAL_P (Paper_outputter); + SCM Paper_outputter::mark_smob (SCM x) { - Paper_outputter * p = (Paper_outputter*) SCM_CELL_WORD_1(x); + Paper_outputter *p = (Paper_outputter*) SCM_CELL_WORD_1(x); scm_gc_mark (p->output_module_); return p->file_; } @@ -68,12 +70,10 @@ Paper_outputter::print_smob (SCM x, SCM p, scm_print_state*) return 1; } - - SCM Paper_outputter::dump_string (SCM scm) { - return scm_display (scm,file_); + return scm_display (scm, file_); } SCM @@ -89,13 +89,12 @@ Paper_outputter::output_scheme (SCM scm) } void -paper_outputter_dump (void * po, SCM x) +paper_outputter_dump (void *po, SCM x) { - Paper_outputter * me = (Paper_outputter*) po; + Paper_outputter *me = (Paper_outputter*) po; me->output_scheme (x); } - void Paper_outputter::output_stencil (Stencil stil) { @@ -103,7 +102,7 @@ Paper_outputter::output_stencil (Stencil stil) (void*) this, Offset (0,0)); } -Paper_outputter* +Paper_outputter * get_paper_outputter (String outname, String f) { progress_indication (_f ("paper output to `%s'...", @@ -112,34 +111,29 @@ get_paper_outputter (String outname, String f) } -IMPLEMENT_SMOBS(Paper_outputter); -IMPLEMENT_DEFAULT_EQUAL_P(Paper_outputter); - -LY_DEFINE(ly_outputter_dump_stencil, "ly:outputter-dump-stencil", - 2, 0,0, (SCM outputter, SCM stencil), - "Dump stencil @var{expr} onto @var{outputter}." - ) +/* FIXME: why is output_* wrapper called dump? */ +LY_DEFINE (ly_outputter_dump_stencil, "ly:outputter-dump-stencil", + 2, 0, 0, (SCM outputter, SCM stencil), + "Dump stencil @var{expr} onto @var{outputter}.") { - Paper_outputter* po = unsmob_outputter (outputter); + Paper_outputter *po = unsmob_outputter (outputter); Stencil *st = unsmob_stencil (stencil); - SCM_ASSERT_TYPE(po, outputter, SCM_ARG1, __FUNCTION__, "Paper_outputter"); - SCM_ASSERT_TYPE(st, stencil, SCM_ARG1, __FUNCTION__, "Paper_outputter"); + SCM_ASSERT_TYPE (po, outputter, SCM_ARG1, __FUNCTION__, "Paper_outputter"); + SCM_ASSERT_TYPE (st, stencil, SCM_ARG1, __FUNCTION__, "Paper_outputter"); po->output_stencil (*st); return SCM_UNSPECIFIED; } - -LY_DEFINE(ly_outputter_dump_string, "ly:outputter-dump-string", - 2, 0, 0, (SCM outputter, SCM str), - "Dump @var{str} onto @var{outputter}.") +LY_DEFINE (ly_outputter_dump_string, "ly:outputter-dump-string", + 2, 0, 0, (SCM outputter, SCM str), + "Dump @var{str} onto @var{outputter}.") { - Paper_outputter* po = unsmob_outputter (outputter); - SCM_ASSERT_TYPE(po, outputter, SCM_ARG1, __FUNCTION__, "Paper_outputter"); - SCM_ASSERT_TYPE(ly_c_string_p (str), str, SCM_ARG1, __FUNCTION__, "Paper_outputter"); - + Paper_outputter *po = unsmob_outputter (outputter); + SCM_ASSERT_TYPE (po, outputter, SCM_ARG1, __FUNCTION__, "Paper_outputter"); + SCM_ASSERT_TYPE (ly_c_string_p (str), str, SCM_ARG1, __FUNCTION__, "Paper_outputter"); + return po->dump_string (str); - return SCM_UNSPECIFIED; } diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm new file mode 100644 index 0000000000..b8001002b6 --- /dev/null +++ b/scm/framework-gnome.scm @@ -0,0 +1,33 @@ +;;;; framework-gnome.scm -- +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2004 Jan Nieuwenhuizen + +(define-module (scm framework-gnome)) + +(use-modules + (guile) + (lily) + (scm output-gnome)) + +;; dump? +(define (dump-page outputter page page-number page-count) + (ly:outputter-dump-stencil outputter (ly:page-stencil page))) + +(define-public (output-framework-gnome outputter book scopes fields basename) + (let* ((bookpaper (ly:paper-book-book-paper book)) + (pages (ly:paper-book-pages book)) + (page-number 0) + (page-count (length pages))) + + (for-each + (lambda (page) + (set! page-number (1+ page-number)) + (dump-page outputter page page-number page-count)) + pages))) + + + + + diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index 7afea69223..eb62b853fd 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -1,3 +1,8 @@ +;;;; framework-ps.scm -- +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2004 Han-Wen Nienhuys (define-module (scm framework-ps)) @@ -5,6 +10,7 @@ (ice-9 string-fun) (ice-9 format) (guile) + (srfi srfi-1) (srfi srfi-13) (scm output-ps) (lily)) @@ -12,21 +18,15 @@ (define (tex-font? fontname) (equal? (substring fontname 0 2) "cm")) - (define (load-fonts bookpaper) - - (let* - ((fonts (ly:bookpaper-fonts bookpaper)) - (font-names (uniq-list (sort (map ly:font-filename fonts) stringstring val)) ((number? val) (number->string val)) (else ""))) - + (define (output-entry ps-key ly-key) (string-append - "/" ps-key " " (value->string (ly:output-def-lookup paper ly-key)) " def \n")) - + "/" ps-key " " + (value->string (ly:output-def-lookup paper ly-key)) " def \n")) + (string-append "/lily-output-units 2.83464 def %% milimeter \n" "% /lily-output-units 0.996264 def %% true points.\n" @@ -121,34 +121,29 @@ (output-entry "staff-height" 'staffheight) ;junkme. "/output-scale " (number->string (ly:output-def-lookup paper 'outputscale)) - " lily-output-units mul def \n" - )) - + " lily-output-units mul def \n")) + (define (header paper page-count classic?) (string-append "%!PS-Adobe-3.0\n" - "%%Creator: creator time-stamp \n" - )) + "%%Creator: creator time-stamp \n")) (define (dump-page outputter page page-number page-count) (ly:outputter-dump-string outputter (string-append - "%%Page: " (number->string page-number) " " (number->string page-count) "\n" + "%%Page: " + (number->string page-number) " " (number->string page-count) "\n" "0 0 start-system { " "set-ps-scale-to-lily-scale " "\n")) (ly:outputter-dump-stencil outputter (ly:page-stencil page)) - (ly:outputter-dump-string outputter - "} stop-system \nshowpage\n") ) - - + (ly:outputter-dump-string outputter "} stop-system \nshowpage\n")) + (define-public (output-framework-ps outputter book scopes fields basename) - (let* - ((bookpaper (ly:paper-book-book-paper book)) - (pages (ly:paper-book-pages book)) - (pageno 0) - (page-count (length pages)) - ) + (let* ((bookpaper (ly:paper-book-book-paper book)) + (pages (ly:paper-book-pages book)) + (page-number 0) + (page-count (length pages))) (for-each (lambda (x) (ly:outputter-dump-string outputter x)) @@ -157,70 +152,65 @@ (length pages) #f) - "%%Pages: " (number->string page-count) "\n" - "%%PageOrder: Ascend\n" - "%%DocumentPaperSizes: " (ly:output-def-lookup bookpaper 'papersize) "\n" - + "%%Pages: " (number->string page-count) "\n" + "%%PageOrder: Ascend\n" + "%%DocumentPaperSizes: " (ly:output-def-lookup bookpaper 'papersize) "\n" + (output-variables bookpaper) (ly:gulp-file "music-drawing-routines.ps") (ly:gulp-file "lilyponddefs.ps") (load-fonts bookpaper) - (define-fonts bookpaper) - )) + (define-fonts bookpaper))) (for-each (lambda (page) - (set! pageno (1+ pageno)) - (dump-page outputter page pageno page-count)) + (set! page-number (1+ page-number)) + (dump-page outputter page page-number page-count)) pages) - (ly:outputter-dump-string outputter "%%Trailer\n%%EOF\n") - )) - - - - -(define-public (output-classic-framework-ps outputter book scopes fields basename) - (let* - ((bookpaper (ly:paper-book-book-paper book)) - (lines (ly:paper-book-lines book)) - (y 0.0) - (scale (* 2.83464 (ly:output-def-lookup bookpaper 'outputscale))) - (total-y (apply + (map (lambda (z) (ly:paper-line-extent z Y)) lines))) - (x-ext '(-8 . 0)) - (lineno 0) - ) - + (ly:outputter-dump-string outputter "%%Trailer\n%%EOF\n"))) + +(define-public (output-classic-framework-ps outputter book scopes fields + basename) + (let* ((bookpaper (ly:paper-book-book-paper book)) + (lines (ly:paper-book-lines book)) + (y 0.0) + (scale (* 2.83464 (ly:output-def-lookup bookpaper 'outputscale))) + (total-y + (apply + (map (lambda (z) (ly:paper-line-extent z Y)) lines))) + (x-ext '(-8 . 0)) + (lineno 0)) + (define (dump-line outputter system) - (let* - ((stil (ly:paper-line-stencil system))) - - (ly:outputter-dump-string - outputter - (string-append - " 0.0 " - (ly:number->string y) - " start-system {\n set-ps-scale-to-lily-scale\n")) - (set! y (+ y (ly:paper-line-extent system Y))) - (ly:outputter-dump-stencil outputter stil) - (ly:outputter-dump-string - outputter - "} stop-system\n"))) + (let ((stil (ly:paper-line-stencil system))) + + (ly:outputter-dump-string + outputter + (string-append + " 0.0 " + (ly:number->string y) + " start-system {\n set-ps-scale-to-lily-scale\n")) + (set! y (+ y (ly:paper-line-extent system Y))) + (ly:outputter-dump-stencil outputter stil) + (ly:outputter-dump-string + outputter + "} stop-system\n"))) (define (to-pt x) (inexact->exact (round (* scale x)))) - - (define (bbox llx lly urx ury) + + (define (bbox llx lly urx ury) (string-append "%%BoundingBox: " (ly:number->string (to-pt llx)) " " - (ly:number->string (to-pt lly)) " " + (ly:number->string (to-pt lly)) " " (ly:number->string (to-pt urx)) " " (ly:number->string (to-pt ury)) "\n")) - (for-each (lambda (l) - (set! x-ext (interval-union x-ext (cons 0.0 (ly:paper-line-extent l X)))) - ) - lines) + (for-each + (lambda (ell) + (set! x-ext (interval-union x-ext + (cons 0.0 (ly:paper-line-extent ell X))))) + lines) (for-each (lambda (x) @@ -236,14 +226,10 @@ (ly:gulp-file "music-drawing-routines.ps") (ly:gulp-file "lilyponddefs.ps") (load-fonts bookpaper) - (define-fonts bookpaper) - )) + (define-fonts bookpaper))) +;; ; page-number page-count)) (for-each - (lambda (line) - (set! lineno (1+ lineno)) - (dump-line outputter line)) ; pageno page-count)) + (lambda (line) (set! lineno (1+ lineno)) (dump-line outputter line)) lines) - (ly:outputter-dump-string outputter "\n") - )) - + (ly:outputter-dump-string outputter "\n"))) diff --git a/scm/framework-tex.scm b/scm/framework-tex.scm index 22330b5f79..23a64ee2e8 100644 --- a/scm/framework-tex.scm +++ b/scm/framework-tex.scm @@ -1,3 +1,9 @@ +;;;; framework-tex.scm -- +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2004 Han-Wen Nienhuys + (define-module (scm framework-tex)) (use-modules (ice-9 regex) @@ -11,7 +17,7 @@ (define (define-fonts bookpaper) (string-append - "\\def\\lilypondpaperunit{mm}" ;; UGH. FIXME. + "\\def\\lilypondpaperunit{mm}" ;; UGH. FIXME. (tex-number-def "lilypondpaper" 'outputscale (number->string (exact->inexact (ly:bookpaper-outputscale bookpaper)))) @@ -20,14 +26,12 @@ (apply string-append (map (lambda (x) (font-load-command bookpaper x)) - (ly:bookpaper-fonts bookpaper) - )))) + (ly:bookpaper-fonts bookpaper))))) (define-public (header-to-file fn key val) (set! key (symbol->string key)) (if (not (equal? "-" fn)) - (set! fn (string-append fn "." key)) - ) + (set! fn (string-append fn "." key))) (display (format "Writing header field `~a' to `~a'..." key @@ -36,11 +40,9 @@ (current-error-port)) (if (equal? fn "-") (display val) - (display val (open-file fn "w")) - ) + (display val (open-file fn "w"))) (display "\n" (current-error-port)) - "" ) - + "") (define (output-scopes scopes fields basename) (define (output-scope scope) @@ -48,17 +50,14 @@ string-append (module-map (lambda (sym var) - (let ((val (if (variable-bound? var) (variable-ref var) "")) - ) - - (if (and (memq sym fields) (string? val)) - (header-to-file basename sym val)) - "")) - scope))) - - (apply string-append - (map output-scope scopes))) - + (let ((val (if (variable-bound? var) (variable-ref var) "")) + ) + + (if (and (memq sym fields) (string? val)) + (header-to-file basename sym val)) + "")) + scope))) + (apply string-append (map output-scope scopes))) (define (tex-string-def prefix key str) (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str))) @@ -67,34 +66,31 @@ "{" (sanitize-tex-string str) "}%\n"))) (define (header creator time-stamp bookpaper page-count classic?) - (let* - ((scale (ly:output-def-lookup bookpaper 'outputscale))) - - (string-append - "% Generated by " creator "\n" - "% at " time-stamp "\n" - (if classic? - (tex-string-def "lilypond" 'classic "1") - "") - - (tex-string-def "lilypondpaper" 'linewidth - (ly:number->string (* scale - (ly:output-def-lookup bookpaper 'linewidth)))) - - (tex-string-def "lilypondpaper" 'interscoreline - (ly:number->string - (* scale - (ly:output-def-lookup bookpaper 'interscoreline)))) - ))) + (let ((scale (ly:output-def-lookup bookpaper 'outputscale))) + + (string-append + "% Generated by " creator "\n" + "% at " time-stamp "\n" + (if classic? + (tex-string-def "lilypond" 'classic "1") + "") + + (tex-string-def + "lilypondpaper" 'linewidth + (ly:number->string (* scale (ly:output-def-lookup bookpaper 'linewidth)))) + + (tex-string-def + "lilypondpaper" 'interscoreline + (ly:number->string + (* scale (ly:output-def-lookup bookpaper 'interscoreline))))))) (define (header-end) (string-append "\\def\\scaletounit{ " (number->string (cond - ((equal? (ly:unit) "mm") (/ 72.0 25.4)) - ((equal? (ly:unit) "pt") (/ 72.0 72.27)) - (else (error "unknown unit" (ly:unit))) - )) + ((equal? (ly:unit) "mm") (/ 72.0 25.4)) + ((equal? (ly:unit) "pt") (/ 72.0 72.27)) + (else (error "unknown unit" (ly:unit))))) " mul }%\n" "\\ifx\\lilypondstart\\undefined\n" " \\input lilyponddefs\n" @@ -104,45 +100,29 @@ "\\lilypondspecial\n" "\\lilypondpostscript\n")) - (define (dump-page putter page) (ly:outputter-dump-string putter "\n\\vbox to 0pt{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n") - (ly:outputter-dump-stencil putter (ly:page-stencil page)) - (ly:outputter-dump-string - putter - (if (ly:page-last? page) - "}\\vss\n}\n\\vfill\n" - "}\\vss\n}\n\\vfill\\lilypondpagebreak\n"))) - - + (ly:outputter-dump-stencil putter (ly:page-stencil page)) + (ly:outputter-dump-string + putter + (if (ly:page-last? page) + "}\\vss\n}\n\\vfill\n" + "}\\vss\n}\n\\vfill\\lilypondpagebreak\n"))) (define-public (output-framework-tex outputter book scopes fields basename) - (let* - ((bookpaper (ly:paper-book-book-paper book)) - (pages (ly:paper-book-pages book)) - ) - (for-each - (lambda (x) - (ly:outputter-dump-string outputter x)) - (list - (header "creator" - "timestamp" - bookpaper - (length pages) - #f - ) - - (define-fonts bookpaper) - (header-end))) - - (for-each - (lambda (page) - (dump-page outputter page)) - pages) - (ly:outputter-dump-string outputter "\\lilypondend\n") - )) + (let* ((bookpaper (ly:paper-book-book-paper book)) + (pages (ly:paper-book-pages book))) + (for-each + (lambda (x) + (ly:outputter-dump-string outputter x)) + (list + (header "creator" "timestamp" bookpaper (length pages) #f) + (define-fonts bookpaper) + (header-end))) + (for-each (lambda (page) (dump-page outputter page)) pages) + (ly:outputter-dump-string outputter "\\lilypondend\n"))) (define (dump-line putter line last?) (ly:outputter-dump-string @@ -151,39 +131,30 @@ (ly:number->string (ly:paper-line-extent line Y)) "}{")) - (ly:outputter-dump-stencil putter (ly:paper-line-stencil line)) - (ly:outputter-dump-string - putter - (if last? - "}%\n" - "}\\interscoreline\n" - )) ) - -(define-public (output-classic-framework-tex outputter book scopes fields basename) - (let* - ((bookpaper (ly:paper-book-book-paper book)) - (lines (ly:paper-book-lines book)) - (last-line (car (last-pair lines)))) - (for-each - (lambda (x) - (ly:outputter-dump-string outputter x)) - (list - (header "creator" ;FIXME - "timestamp" - bookpaper - (length lines) - #f) - "\\def\\lilypondclassic{1}%\n" - (output-scopes scopes fields basename) - (define-fonts bookpaper) - (header-end))) - - (for-each - (lambda (line) - (dump-line outputter line (eq? line last-line))) - lines) - (ly:outputter-dump-string outputter "\\lilypondend\n") - )) - - - + (ly:outputter-dump-stencil putter (ly:paper-line-stencil line)) + (ly:outputter-dump-string + putter + (if last? + "}%\n" + "}\\interscoreline\n"))) + +(define-public (output-classic-framework-tex + outputter book scopes fields basename) + (let* ((bookpaper (ly:paper-book-book-paper book)) + (lines (ly:paper-book-lines book)) + (last-line (car (last-pair lines)))) + (for-each + (lambda (x) + (ly:outputter-dump-string outputter x)) + (list + ;;FIXME + (header "creator" "timestamp" bookpaper (length lines) #f) + "\\def\\lilypondclassic{1}%\n" + (output-scopes scopes fields basename) + (define-fonts bookpaper) + (header-end))) + + (for-each + (lambda (line) (dump-line outputter line (eq? line last-line))) lines) + (ly:outputter-dump-string outputter "\\lilypondend\n"))) + diff --git a/scm/lily.scm b/scm/lily.scm index 264f4be59a..5441024e23 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -380,11 +380,10 @@ L1 is copied, L2 not. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; output -(use-modules (scm framework-tex) - (scm framework-ps) - ) - - +(use-modules + (scm framework-gnome) + (scm framework-tex) + (scm framework-ps)) (define output-tex-module (make-module 1021 (list (resolve-interface '(scm output-tex))))) diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm index 99eff850c5..83581c9306 100644 --- a/scm/output-gnome.scm +++ b/scm/output-gnome.scm @@ -96,8 +96,6 @@ guile -s ../src/libgnoecanvas/examples/canvas.scm " - - (debug-enable 'backtrace) (define-module (scm output-gnome)) @@ -148,8 +146,7 @@ guile -s ../src/libgnoecanvas/examples/canvas.scm ;; minimal intercept list: (define output-interface-intercept - '( - comment + '(comment define-fonts end-output header @@ -160,8 +157,7 @@ guile -s ../src/libgnoecanvas/examples/canvas.scm start-page stop-page start-system - stop-system - )) + stop-system)) (map (lambda (x) (module-define! this-module x dummy)) output-interface-intercept) @@ -289,6 +285,18 @@ guile -s ../src/libgnoecanvas/examples/canvas.scm ((2button-press) (gobject-set-property item 'fill-color "red"))) #t) +;; TODO: one list per-page +(define text-items '()) + +(define (scale-canvas factor) + (set! pixels-per-unit (* pixels-per-unit factor)) + (set-pixels-per-unit main-canvas pixels-per-unit) + (for-each + (lambda (x) + (let ((scale gobject-get-property x 'scale)) + (gobject-set-property x 'scale pixels-per-unit))) + text-items)) + (define (key-press-event item event . data) (let ((keyval (gdk-event-key:keyval event)) (mods (gdk-event-key:modifiers event))) @@ -298,12 +306,10 @@ guile -s ../src/libgnoecanvas/examples/canvas.scm (gtk-main-quit)) ((and #t ;;(null? mods) (eq? keyval gdk:plus)) - (set! pixels-per-unit (* pixels-per-unit 2)) - (set-pixels-per-unit main-canvas pixels-per-unit)) + (scale-canvas 2)) ((and #t ;; (null? mods) (eq? keyval gdk:minus)) - (set! pixels-per-unit (/ pixels-per-unit 2)) - (set-pixels-per-unit main-canvas pixels-per-unit))) + (scale-canvas 0.5))) #f)) (define (char font i) @@ -388,17 +394,24 @@ guile -s ../src/libgnoecanvas/examples/canvas.scm (stderr "font-name: ~S\n" (ly:font-name font)) ;; TODO s/filename/file-name/ (stderr "font-filename: ~S\n" (ly:font-filename font)) - (make - #:parent canvas-root - #:x 0 #:y 0 - ;; #:font "new century schoolbook, i bold 20" - #:font (pango-font-name font) - ;; #:size-points 12 - #:size-points (pango-font-size font) - ;;#:size (pango-font-size font) - #:size-set #t - #:fill-color "black" - #:text string)) + (set! + text-items + (cons + (make + #:parent canvas-root + #:x 0 #:y 0 + ;; #:font "new century schoolbook, i bold 20" + #:font (pango-font-name font) + ;; #:size-points 12 + #:size-points (pango-font-size font) + ;;#:size (pango-font-size font) + #:size-set #t + #:scale 1.0 + #:scale-set #t + #:fill-color "black" + #:text string) + text-items)) + (car text-items)) (define (filledbox a b c d) (round-filled-box a b c d 0.001)) @@ -420,8 +433,3 @@ guile -s ../src/libgnoecanvas/examples/canvas.scm (list line col file) #f))) -;; AARGH -;;(define (define-fonts paper . rest) -;;(define (define-fonts foebar paper) -;; ;; Ughr -;; (set! font-paper paper)) -- 2.39.5