From: Jan Nieuwenhuizen Date: Sun, 13 Jun 2004 21:39:03 +0000 (+0000) Subject: * buildscripts/guile-gnome.sh: New file. X-Git-Tag: release/2.3.4~2 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=e86df222dd423978a0cda29647f09973aacf7a9b;p=lilypond.git * buildscripts/guile-gnome.sh: New file. * scm/output-gnome.scm: White background, better window size, sane canvas size. Cleanups. --- diff --git a/ChangeLog b/ChangeLog index 350a9c7e42..97d27adb7d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,7 +1,9 @@ 2004-06-13 Jan Nieuwenhuizen + * buildscripts/guile-gnome.sh: New file. + * scm/output-gnome.scm: White background, better window size, sane - canvas size. + canvas size. Cleanups. 2004-06-13 Han-Wen Nienhuys diff --git a/buildscripts/guile-gnome.sh b/buildscripts/guile-gnome.sh new file mode 100644 index 0000000000..aa7e9fe166 --- /dev/null +++ b/buildscripts/guile-gnome.sh @@ -0,0 +1,94 @@ +#!@BASH@ +# guile-gnome.sh -- download, compile, install guile-gnome + +# LilyPond has an experimental gnome canvas output backend -- hackers +# only. This depends on unreleased version of guile-gnome, which +# depends on an unreleased, forked version of g-wrap. + +# Note: this install information is volatile, you'll probably want to +# pull all from from guile-gnome-devel@gnu.org--2004 soon. + +set -ex + +if [ -d $HOME/usr/pkg/libffi/ ]; then + export LDFLAGS=-L$HOME/usr/pkg/libffi/lib + export CPPFLAGS=-I$HOME/usr/pkg/libffi/include +fi + +export AUTOMAKE=automake-1.8 +export AUTOCONF=autoconf2.50 + +# test: the name of our download and build directory +rm -rf test +mkdir test +cd test + +## 1. install gnome-devel +## - Debian/unstable: apt-get install gnome-devel +## - ... + + +## 2. *** NOTE: use guile-1.6 for g-wrap and guile-gnome *** +## using GUILE CVS g-wrap/guile-gnome is experimental (read: segfaults) +## Assuming that system has guile-1.6 installed in /usr/bin +PATH=/usr/bin:$PATH + +## 3. get g-wrap 2.0 +tla register-archive a.rottmann@gmx.at--2004-main \ + http://people.debian.org/~rotty/arch/a.rottmann@gmx.at/2004-main || true + +rm -rf g-wrap +## tla get a.rottmann@gmx.at--2004-main/g-wrap--tng g-wrap +## pull latest g-wrap from janneke -- this step is probably no longer +## necessary when you read this +tla register-archive janneke@gnu.org--2004-gnome http://lilypond.org/~janneke/{arch}/2004-gnome || true +tla get janneke@gnu.org--2004-gnome/g-wrap--janneke g-wrap +cd g-wrap + +rm -rf $HOME/usr/pkg/g-wrap +sh autogen.sh --noconfigure +mkdir =build +cd =build +../configure --prefix=$HOME/usr/pkg/g-wrap +make install + +# cp srfi-34.scm from CVS head ? --hwn +(cd $HOME/usr/pkg/g-wrap/share/guile/site + mv srfi-34.scm srfi-34.scm-g-wrap + cp $HOME/usr/pkg/guile/share/guile-1.7/srfi/srfi-34.scm .) + +cd ../.. + +## 4. get guile-gnome +tla register-archive guile-gnome-devel@gnu.org--2004 http://people.debian.org/~rotty/arch/guile-gnome-devel@gnu.org/2004/ || true +rm -rf guile-gnome +tla get guile-gnome-devel@gnu.org--2004/dists--dev guile-gnome +cd guile-gnome +tla build-config -r configs/gnu.org/dev +cd src + +## 5. get the gnome canvas module +tla get guile-gnome-devel@gnu.org--2004/libgnomecanvas--dev libgnomecanvas + +rm -rf $HOME/usr/pkg/guile-gnome +sh autogen.sh --noconfigure +mkdir ../=build +cd ../=build + +export GUILE_LOAD_PATH=$HOME/usr/pkg/g-wrap/share/guile/site:$GUILE_LOAD_PATH +export LD_LIBRARY_PATH=$HOME/usr/pkg/g-wrap/lib:$LD_LIBRARY_PATH +export PKG_CONFIG_PATH=$HOME/usr/pkg/g-wrap/lib/pkgconfig:$PKG_CONFIG_PATH + +../src/configure --prefix=$HOME/usr/pkg/guile-gnome + +# requires 800mb RAM with -O2 +# using gcc-3.4 may help here -- jcn +(cd libgnomecanvas/gnome/gw; perl -i~ -pe 's/-O2//g' Makefile) + +G_WRAP_MODULE_DIR=$HOME/usr/pkg/g-wrap/share/guile/site make install + +export GUILE_LOAD_PATH=$HOME/usr/pkg/guile-gnome/share/guile:$GUILE_LOAD_PATH +export LD_LIBRARY_PATH=$HOME/usr/pkg/guile-gnome/lib:$LD_LIBRARY_PATH + +# simple test +guile -s ../src/libgnomecanvas/examples/canvas.scm diff --git a/lily/accidental.cc b/lily/accidental.cc index 0958dbae8e..e89306f41b 100644 --- a/lily/accidental.cc +++ b/lily/accidental.cc @@ -1,9 +1,10 @@ /* accidental.cc -- implement Accidental_interface - (c) 2001--2004 Han-Wen Nienhuys + source file of the GNU LilyPond music typesetter - */ + (c) 2001--2004 Han-Wen Nienhuys +*/ #include "font-interface.hh" #include "item.hh" #include "stencil.hh" diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm index 16564c6fb5..7980d184a7 100644 --- a/scm/output-gnome.scm +++ b/scm/output-gnome.scm @@ -4,48 +4,43 @@ ;;;; ;;;; (c) 2004 Jan Nieuwenhuizen - ;;; HIP -- hack in progress ;;; ;;; You need: ;;; ;;; * guile-1.6.4 (NOT CVS) ;;; * Rotty's g-wrap--tng, possibly Janneke's if you have libffi-3.4. -;;; * lilypond branch: lilypond_2_3_2b; the framework-* backend -;;; loads output-gnome.scm at startup, which seems to break g-wrapped -;;; goops. ;;; ;;; see also: guile-gtk-general@gnu.org ;;; ;;; Try it ;;; -;;; * Install g-wrap, guile-gnome (see script below) +;;; * Install gnome/gtk development stuff and g-wrap, guile-gnome +;;; see buildscripts/guile-gnome.sh ;;; ;;; * Use latin1 encoding for gnome backend, do -;;; make -C mf clean -;;; make -C mf ENCODING_FILE=$(kpsewhich cork.enc) -;;; (cd mf/out && mkfontdir) -;;; xset +fp $(pwd)/mf/out +" + make -C mf clean + make -C mf ENCODING_FILE=$(kpsewhich cork.enc) + (cd mf/out && mkfontdir) + xset +fp $(pwd)/mf/out +" ;;; -;;; * Setup PATHs: - +;;; * Setup environment " -# do not use guile CVS: -export PATH=/usr/bin/:$PATH -# use g-wrap and guile-gnome from usr/pkg export GUILE_LOAD_PATH=$HOME/usr/pkg/g-wrap/share/guile/site:$HOME/usr/pkg/g-wrap/share/guile/site/g-wrap:$HOME/usr/pkg/guile-gnome/share/guile export LD_LIBRARY_PATH=$HOME/usr/pkg/g-wrap/lib:$HOME/usr/pkg/guile-gnome/lib +export XEDITOR='/usr/bin/emacsclient --no-wait +%l:%c %f' " - -;;; * Set XEDITOR and add +;;; * For GNOME point-and-click, add ;;; #(ly:set-point-and-click 'line-column) -;;; to your .ly to get point-and-click -;;; -;;; * Run lily: lilypond-bin -fgnome input/simple-song.ly +;;; to your .ly; just click an object on the canvas. ;;; -;;; -;;; todo: hmm --output-base broken? -;;; ### cd mf && mftrace --encoding=$(kpsewhich cork.enc) --autotrace --output-base=feta-cork-20 feta20.mf && mv feta20.pfa out +;;; * Run lily: +" +lilypond-bin -fgnome input/simple-song.ly +" + ;;; TODO: ;;; * pango+feta font (see archives gtk-i18n-list@gnome.org and @@ -60,106 +55,7 @@ export LD_LIBRARY_PATH=$HOME/usr/pkg/g-wrap/lib:$HOME/usr/pkg/guile-gnome/lib ;;; * cleanups: (too many) global vars ;;; * papersize, outputscale from book -;;; Note: this install information is volatile -;;; you'll probably want to pull all from -;;; from guile-gnome-devel@gnu.org--2004 soon -;;; - -" -#!/bin/bash - -set -ex - -# no CVS guile. -export PATH=/usr/bin/:$PATH - -if [ -d $HOME/usr/pkg/libffi/ ] ; then - export LDFLAGS=-L$HOME/usr/pkg/libffi/lib/ - export CPPFLAGS=-I$HOME/usr/pkg/libffi/include -fi - -export AUTOMAKE=automake-1.8 -export AUTOCONF=autoconf2.50 - -rm -rf test -mkdir test -cd test - -## 1. install gnome-devel (Debian/unstable: apt-get install gnome-devel) - -## 2. *** NOTE: use guile-1.6 for g-wrap and guile-gnome *** -##### using GUILE CVS g-wrap/guile-gnome is experimental (read: segfaults) -PATH=/usr/bin:$PATH - - -## 3. get g-wrap 2.0 -tla register-archive a.rottmann@gmx.at--2004-main http://people.debian.org/~rotty/arch/a.rottmann@gmx.at/2004-main || true - -rm -rf g-wrap -## tla get a.rottmann@gmx.at--2004-main/g-wrap--tng g-wrap -## pull latest g-wrap from janneke -- this step is probably no longer -## necessary when you read this -tla register-archive janneke@gnu.org--2004-gnome http://lilypond.org/~janneke/{arch}/2004-gnome || true -tla get janneke@gnu.org--2004-gnome/g-wrap--janneke g-wrap -cd g-wrap - -rm -rf $HOME/usr/pkg/g-wrap -sh autogen.sh --noconfigure -mkdir =build -cd =build -../configure --prefix=$HOME/usr/pkg/g-wrap -make install - -# cp srfi-34.scm from CVS head ? --hwn -(cd $HOME/usr/pkg/g-wrap/share/guile/site - mv srfi-34.scm srfi-34.scm-g-wrap - cp $HOME/usr/pkg/guile/share/guile-1.7/srfi/srfi-34.scm .) - -cd ../.. - -## 4. get guile-gnome -tla register-archive guile-gnome-devel@gnu.org--2004 http://people.debian.org/~rotty/arch/guile-gnome-devel@gnu.org/2004/ || true -rm -rf guile-gnome -tla get guile-gnome-devel@gnu.org--2004/dists--dev guile-gnome -cd guile-gnome -tla build-config -r configs/gnu.org/dev -cd src - -## 5. get the gnome canvas module -tla get guile-gnome-devel@gnu.org--2004/libgnomecanvas--dev libgnomecanvas - -## pull latest defs from janneke -- this step is probably no longer -## necessary when you read this -## tla register-archive janneke@gnu.org--2004-gnome http://lilypond.org/~janneke/{arch}/2004-gnome || true -## rm -rf defs -## tla get janneke@gnu.org--2004-gnome/defs--janneke defs - -rm -rf $HOME/usr/pkg/guile-gnome -sh autogen.sh --noconfigure -mkdir ../=build -cd ../=build - -export GUILE_LOAD_PATH=$HOME/usr/pkg/g-wrap/share/guile/site:$GUILE_LOAD_PATH -export LD_LIBRARY_PATH=$HOME/usr/pkg/g-wrap/lib:$LD_LIBRARY_PATH -export PKG_CONFIG_PATH=$HOME/usr/pkg/g-wrap/lib/pkgconfig:$PKG_CONFIG_PATH - -../src/configure --prefix=$HOME/usr/pkg/guile-gnome - -# requires 800mb RAM with -O2 -(cd libgnomecanvas/gnome/gw; perl -i~ -pe 's/-O2//g' Makefile) - -G_WRAP_MODULE_DIR=$HOME/usr/pkg/g-wrap/share/guile/site make install - -export GUILE_LOAD_PATH=$HOME/usr/pkg/guile-gnome/share/guile:$GUILE_LOAD_PATH -export LD_LIBRARY_PATH=$HOME/usr/pkg/guile-gnome/lib:$LD_LIBRARY_PATH -guile -s ../src/libgnomecanvas/examples/canvas.scm - - -# simple test -guile -s ../src/libgnomecanvas/examples/canvas.scm - -" (debug-enable 'backtrace) @@ -173,12 +69,35 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm (srfi srfi-13) (lily) (gnome gtk) - (gnome gtk gdk-event) - ;; the name of the module will change to canvas rsn - ;;(gnome gw libgnomecanvas)) - (gnome gw canvas)) + (gnome gtk gdk-event)) + +;; the name of the module will change to canvas rsn +(if (resolve-module '(gnome gw canvas)) + (use-modules (gnome gw canvas)) + (use-modules (gnome gw libgnomecanvas))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; module entry +(define-public (gnome-output-expression expr port) + (display (dispatch expr) port)) + +(define (dispatch expr) + (if (pair? expr) + (let ((keyword (car expr))) + (cond + ((eq? keyword 'some-func) "") + ;;((eq? keyword 'placebox) (dispatch (cadddr expr))) + (else + (if (module-defined? this-module keyword) + (apply (eval keyword this-module) (cdr expr)) + (begin + (display + (string-append "undefined: " (symbol->string keyword) "\n")) + ""))))) + expr)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Lily output interface --- fix silly names and docme " @@ -190,11 +109,12 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm beam bezier-sandwich bracket + char + filledbox + text ... Commands: - define-fonts - header placebox ... @@ -215,38 +135,14 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm ;; minimal intercept list: (define output-interface-intercept '(comment - define-fonts - end-output - header - header-end - lily-def - no-origin - output-scopes - start-page - stop-page - start-system - stop-system)) + define-origin + no-origin)) (map (lambda (x) (module-define! this-module x dummy)) output-interface-intercept) -(define-public (gnome-output-expression expr port) - (display (dispatch expr) port)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (dispatch expr) - (if (pair? expr) - (let ((keyword (car expr))) - (cond - ((eq? keyword 'some-func) "") - ;;((eq? keyword 'placebox) (dispatch (cadddr expr))) - (else - (if (module-defined? this-module keyword) - (apply (eval keyword this-module) (cdr expr)) - (begin - (display - (string-append "undefined: " (symbol->string keyword) "\n")) - ""))))) - expr)) ;;; Global vars (define main-window #f) @@ -273,15 +169,9 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm (define font-paper #f) -;;(define pixels-per-unit 1.0) (define pixels-per-unit 2.0) - -;; TODO: use canvas scaling, use output-scale for paper/canvas dimensions? -;;(define output-scale (* 2 2.83464566929134)) -;;(define output-scale 2.83464566929134) (define OUTPUT-SCALE 2.83464566929134) (define output-scale (* OUTPUT-SCALE pixels-per-unit)) -;;(define output-scale 1) ;; helper functions -- sort this out (define (stderr string . rest) @@ -313,90 +203,16 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm (utf8 i) (utf8 (+ #xee00 i)))) -(define x-editor #f) -(define (get-x-editor) - (if (not x-editor) - (set! x-editor (getenv "XEDITOR"))) - x-editor) - -(define ifs #f) -(define (get-ifs) - (if (not ifs) - (set! ifs (getenv "IFS"))) - (if (not ifs) - (set! ifs " ")) - ifs) - -(define (spawn-editor location) - (let* ((line (car location)) - (column (cadr location)) - (file-name (caddr location)) - (template (substring (get-x-editor) 0)) - - ;; Adhere to %l %c %f? - (command - (regexp-substitute/global - #f "%l" (regexp-substitute/global - #f "%c" - (regexp-substitute/global - #f "%f" template 'pre file-name 'post) - 'pre (number->string column) - 'post) - 'pre (number->string line) 'post))) - - (stderr "spawning: ~s\n" command) - (if (= (primitive-fork) 0) - (let ((command-list (string-split command #\ )));; (get-ifs)))) - (apply execlp command-list) - (primitive-exit))))) - -(define location-callback spawn-editor) - -(define (item-event item event . data) - (case (gdk-event:type event) - ((enter-notify) (gobject-set-property item 'fill-color "red")) - ((leave-notify) (gobject-set-property item 'fill-color "black")) - ((button-press) - (let ((location (hashq-ref item-locations item #f))) - (if location - (location-callback location) - (stderr "no location\n")))) - ((2button-press) (gobject-set-property item 'fill-color "red"))) - #t) +;;; hmm? +(define (draw-rectangle x1 y1 x2 y2 color width-units) + (make + #:parent (root main-canvas) #:x1 x1 #:y1 y1 #:x2 x2 #:y2 y2 + #:fill-color color #:width-units width-units)) -;; 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)) - (points (gobject-get-property x 'size-points))) - ;;(gobject-set-property x 'scale pixels-per-unit) - (gobject-set-property x 'size-points (* points factor)))) - text-items)) -(define (key-press-event item event . data) - (let ((keyval (gdk-event-key:keyval event)) - (mods (gdk-event-key:modifiers event))) - (cond ((and (or (eq? keyval gdk:q) - (eq? keyval gdk:w)) - (equal? mods '(control-mask modifier-mask))) - (gtk-main-quit)) - ((and #t ;;(null? mods) - (eq? keyval gdk:plus)) - (scale-canvas 2)) - ((and #t ;; (null? mods) - (eq? keyval gdk:minus)) - (scale-canvas 0.5)) - ((or (eq? keyval gdk:Page-Up) - (eq? keyval gdk:BackSpace)) - (dump-page (1- page-number))) - ((or (eq? keyval gdk:Page-Down) - (eq? keyval gdk:space)) - (dump-page (1+ page-number)))) - #f)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; stencil outputters +;;;; (define (char font i) (text font (utf8 i))) @@ -429,7 +245,7 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm ((equal? (ly:font-name font) "GNU-LilyPond-feta-20") "lilypond-feta, regular 32") (else - (ly:font-filename font)))) + (ly:font-name font)))) (define (pango-font-size font) (let* ((designsize (ly:font-design-size font)) @@ -454,11 +270,8 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm (make #:parent (root main-canvas) #: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 ;;apparently no effect :-( @@ -479,9 +292,6 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm ;;(let ((thickness 2)) (filledbox (- x1) (- x2 x1) (* .5 thickness) (* .5 thickness))) -(define (start-system origin . rest) - (set! system-origin origin)) - ;; origin -- bad name (define (define-origin file line col) ;; ughr, why is this not passed as [part of] stencil object @@ -492,9 +302,9 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm #f))) -;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;; gnome stuff -;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; gnome stuff --- move to framework-gnome (define (dump-page number) (if (or (not page-stencils) (< number 0) @@ -517,24 +327,114 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm (if old-canvas (destroy old-canvas)) (add main-scrolled canvas) - (show canvas) - ))) + (show canvas)))) +(define x-editor #f) +(define (get-x-editor) + (if (not x-editor) + (set! x-editor (getenv "XEDITOR"))) + x-editor) + +(define ifs #f) +(define (get-ifs) + (if (not ifs) + (set! ifs (getenv "IFS"))) + (if (not ifs) + (set! ifs " ")) + ifs) + +(define (spawn-editor location) + (let* ((line (car location)) + (column (cadr location)) + (file-name (caddr location)) + (template (substring (get-x-editor) 0)) + + ;; Adhere to %l %c %f? + (command + (regexp-substitute/global + #f "%l" (regexp-substitute/global + #f "%c" + (regexp-substitute/global + #f "%f" template 'pre file-name 'post) + 'pre (number->string column) + 'post) + 'pre (number->string line) 'post))) + + (stderr "spawning: ~s\n" command) + (if (= (primitive-fork) 0) + (let ((command-list (string-split command #\ )));; (get-ifs)))) + (apply execlp command-list) + (primitive-exit))))) + +(define location-callback spawn-editor) + +(define (item-event item event . data) + (case (gdk-event:type event) + ((enter-notify) (gobject-set-property item 'fill-color "red")) + ((leave-notify) (gobject-set-property item 'fill-color "black")) + ((button-press) + (let ((location (hashq-ref item-locations item #f))) + (if location + (location-callback location) + (stderr "no location\n")))) + ((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)) + (points (gobject-get-property x 'size-points))) + ;;(gobject-set-property x 'scale pixels-per-unit) + (gobject-set-property x 'size-points (* points factor)))) + text-items)) + +(define (key-press-event item event . data) + (let ((keyval (gdk-event-key:keyval event)) + (mods (gdk-event-key:modifiers event))) + (cond ((and (or (eq? keyval gdk:q) + (eq? keyval gdk:w)) + (equal? mods '(control-mask modifier-mask))) + (gtk-main-quit)) + ((and #t ;;(null? mods) + (eq? keyval gdk:plus)) + (scale-canvas 2)) + ((and #t ;; (null? mods) + (eq? keyval gdk:minus)) + (scale-canvas 0.5)) + ((or (eq? keyval gdk:Page-Up) + (eq? keyval gdk:BackSpace)) + (dump-page (1- page-number))) + ((or (eq? keyval gdk:Page-Down) + (eq? keyval gdk:space)) + (dump-page (1+ page-number)))) + #f)) (define (papersize window paper) (let* ((hsize (ly:output-def-lookup paper 'hsize)) (vsize (ly:output-def-lookup paper 'vsize)) - ;; 2? - (width (inexact->exact (ceiling (* output-scale 2 hsize)))) - (height (inexact->exact (ceiling (* output-scale 2 vsize)))) + (width (inexact->exact (ceiling (* output-scale hsize)))) + (height (inexact->exact (ceiling (* output-scale vsize)))) (max-width (gdk-screen-width)) - (max-height (gdk-screen-height))) + (max-height (gdk-screen-height)) + (scrollbar-size 20)) ;; ughr: panels? (set! max-height (- max-height 80)) + + ;; hmm? + ;;(set! OUTPUT-SCALE (ly:bookpaper-outputscale paper)) + ;;(set! output-scale (* OUTPUT-SCALE pixels-per-unit)) + + ;; huh, *2? - (set! window-width (min width max-width)) - (set! window-height (min height max-height)) + (set! window-width (min (+ scrollbar-size (* width 2)) max-width)) + (set! window-height (min (+ button-height scrollbar-size (* height 2)) + max-height)) (set! canvas-width width) (set! canvas-height height))) @@ -554,11 +454,6 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm canvas)) -(define (draw-rectangle x1 y1 x2 y2 color width-units) - (make - #:parent (root main-canvas) #:x1 x1 #:y1 y1 #:x2 x2 #:y2 y2 - #:fill-color color #:width-units width-units)) - (define (main outputter bookpaper pages) (let* ((window (make #:type 'toplevel)) (button (make #:label "Exit")) @@ -571,7 +466,6 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm (papersize window bookpaper) (set-size-request window window-width window-height) - ;;; (ly:bookpaper-outputscale bookpaper)))) (add window vbox) (add vbox scrolled)