From: Jan Nieuwenhuizen Date: Sun, 13 Jun 2004 11:37:27 +0000 (+0000) Subject: * scm/output-gnome.scm: Handle multiple pages. X-Git-Tag: release/2.3.4~12 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=a6925eea61f3275c9411502f54c567daa48b55a8;p=lilypond.git * scm/output-gnome.scm: Handle multiple pages. --- diff --git a/ChangeLog b/ChangeLog index e9fb6380bf..d2fdb05d4d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -14,6 +14,8 @@ 2004-06-13 Jan Nieuwenhuizen + * scm/output-gnome.scm: Handle multiple pages. + * scm/framework-gnome.scm: Do not load output-gnome. (framework-gnome): Invoke output-gnome::header and output-gnome::end-output as faked stencils. Fixes experimental diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm index f505236d58..a35f22aa2d 100644 --- a/scm/framework-gnome.scm +++ b/scm/framework-gnome.scm @@ -10,29 +10,12 @@ (guile) (lily)) -;; 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))) - - ;;(header) - ;; FIXME: should output command, not stencil? - ;;(ly:outputter-dump-string outputter '(header)) - ;; hmm, probably need (ly:outputter-command but its too late for that - ;; kind of elegancy now :-) - (ly:outputter-dump-stencil outputter (ly:make-stencil '(header) - '(0 . 0) '(0 . 0))) - - (for-each - (lambda (page) - (set! page-number (1+ page-number)) - (dump-page outputter page page-number page-count)) - pages) + (pages (list->vector (map ly:page-stencil + (ly:paper-book-pages book))))) + + (ly:outputter-dump-stencil + outputter + (ly:make-stencil (list 'main outputter pages) '(0 . 0) '(0 . 0))))) - (ly:outputter-dump-stencil outputter (ly:make-stencil '(end-output) - '(0 . 0) '(0 . 0))))) diff --git a/scm/lily.scm b/scm/lily.scm index 669946eea9..823015b370 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -11,10 +11,6 @@ (if (defined? 'set-debug-cell-accesses!) (set-debug-cell-accesses! #f)) -;; ugh, need this for encoding.scm test -;; srfi-13 overrides string->list -(define-public plain-string->list string->list) - (use-modules (ice-9 regex) (ice-9 safe) (oop goops) diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm index 45830fcc30..561726558b 100644 --- a/scm/output-gnome.scm +++ b/scm/output-gnome.scm @@ -55,8 +55,9 @@ export LD_LIBRARY_PATH=$HOME/usr/pkg/g-wrap/lib:$HOME/usr/pkg/guile-gnome/lib ;;; - hack feta20/feta20.pfa?: ;;; * font, canvas, scaling? ;;; * implement missing stencil functions -;;; * implement missing commands (next, prev? page) +;;; * implement missing commands ;;; * user-interface, keybindings +;;; * cleanups: (too many) global vars ;;; Note: this install information is volatile ;;; you'll probably want to pull all from @@ -146,8 +147,7 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm (debug-enable 'backtrace) -(define-module (scm output-gnome) - #:export (header)) +(define-module (scm output-gnome)) (define this-module (current-module)) @@ -159,8 +159,8 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm (gnome gtk) (gnome gtk gdk-event) ;; the name of the module will change to canvas rsn - (gnome gw libgnomecanvas)) - ;;(gnome gw canvas)) + ;;(gnome gw libgnomecanvas)) + (gnome gw canvas)) ;;; Lily output interface --- fix silly names and docme @@ -234,8 +234,13 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm ;;; Global vars (define main-window #f) +(define main-scrolled #f) (define main-canvas #f) (define canvas-root #f) +(define page-number 0) + +(define page-stencils #f) +(define output-canvas #f) (define system-origin '(0 . 0)) @@ -346,11 +351,8 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm (lambda (x) (let ((scale (gobject-get-property x 'scale)) (points (gobject-get-property x 'size-points))) - ;;(stderr "scaling item:~S to ~S\n" x scale) - ;; (stderr "scaling item:~S to ~S\n" x points) - (gobject-set-property x 'size-points (* points factor)))) ;;(gobject-set-property x 'scale pixels-per-unit) - ;;(gobject-set-property x 'scale-set #t)) + (gobject-set-property x 'size-points (* points factor)))) text-items)) (define (key-press-event item event . data) @@ -365,7 +367,13 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm (scale-canvas 2)) ((and #t ;; (null? mods) (eq? keyval gdk:minus)) - (scale-canvas 0.5))) + (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 (char font i) @@ -396,41 +404,66 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm #:x1 (- breapth) #:y1 depth #:x2 width #:y2 (- height) #:fill-color "black" #:width-units blot-diameter)) -(define (fontify font expr) - #f) - -(define (end-output) - (gtk-main)) +;;(define (fontify font expr) +;; #f) -(define (header . rest) +(define (main outputter pages) (let* ((window (make #:type 'toplevel)) (button (make #:label "Exit")) + (next (make #:label "Next")) + (prev (make #:label "Previous")) (canvas (make )) (vbox (make #:homogeneous #f)) + (hbox (make #:homogeneous #f)) (scrolled (make ))) (add window vbox) (add vbox scrolled) (add scrolled canvas) - (set-size-request button canvas-width 20) - (add vbox button) - (set-child-packing vbox button #f #f 0 'end) - + ;;(set-size-request button canvas-width 20) + ;;(add vbox button) + ;;(set-child-packing vbox button #f #f 0 'end) + + (add vbox hbox) + (set-size-request hbox canvas-width 25) + (set-child-packing vbox hbox #f #f 0 'end) + + (set-child-packing hbox button #f #f 0 'end) + ;;(set-size-request next 40 25) + ;;(set-size-request prev 40 25) + (set-size-request button (/ canvas-width 2) 25) + + (add hbox next) + (add hbox prev) + (add hbox button) + + (gtype-instance-signal-connect button 'clicked (lambda (b) (gtk-main-quit))) + (gtype-instance-signal-connect next 'clicked + (lambda (b) (dump-page (1+ page-number)))) + (gtype-instance-signal-connect prev 'clicked + (lambda (b) (dump-page (1- page-number)))) ;; papersize (set-size-request canvas canvas-width canvas-height) (set-scroll-region canvas 0 0 2000 4000) + (set-pixels-per-unit canvas pixels-per-unit) (gtype-instance-signal-connect window 'key-press-event key-press-event) - - (set-pixels-per-unit canvas pixels-per-unit) (show-all window) + + ;; HMMM (set! canvas-root (root canvas)) (set! main-canvas canvas) - (set! main-window window))) + (set! main-window window) + (set! output-canvas outputter) + (set! page-stencils pages) + (set! main-scrolled scrolled) + + (dump-page 0) + (gtk-main))) (define (pango-font-name font) (cond @@ -499,3 +532,37 @@ guile -s ../src/libgnomecanvas/examples/canvas.scm (list line col file) #f))) +(define (dump-page number) + (if (or (not page-stencils) + (< number 0) + (>= number (vector-length page-stencils))) + (stderr "No such page: ~S\n" (1+ number)) + (begin + (set! page-number number) + + ;; no destroy method for gnome-canvas-text? + ;;(map destroy (gtk-container-get-children main-canvas)) + ;;(map destroy text-items) + + ;; UGHR - destroying the whole canvas.... + (if (and main-canvas + (not (null? text-items))) + (let* ((canvas (make )) + (root (root canvas))) + + (destroy main-canvas) + (add main-scrolled canvas) + + ;; papersize + (set-size-request canvas canvas-width canvas-height) + (set-scroll-region canvas 0 0 2000 4000) + (set-pixels-per-unit canvas pixels-per-unit) + (show canvas) + + (set! main-canvas canvas) + (set! canvas-root root) + (set! text-items '()))) + + (ly:outputter-dump-stencil output-canvas + (vector-ref page-stencils page-number))))) +