* lily/include/book-paper-def.hh: Add. Janitorial fixes.
-2004-05-17 Han-Wen Nienhuys <hanwen@xs4all.nl>
+2004-05-17 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * scm/output-gnome.scm: New file.
+ * lily/include/book-paper-def.hh: Add. Janitorial fixes.
+
+2004-05-17 Han-Wen Nienhuys <hanwen@xs4all.nl>
* lily/book-paper-def.cc (ly_bookpaper_fonts): move from Paperdef
(find_scaled_font): move from Paper_def
correct duration for each syllable. This is achieved by combining the
melody and the lyrics with the @code{\lyricsto} expression
@example
-\lyricsto @var{name} \new Lyrics @dots{}
+\lyricsto @var{name} \new Lyrics \lyrics @dots{}
@end example
This aligns the lyrics to the
IMPLEMENT_SMOBS (Book_paper_def);
IMPLEMENT_DEFAULT_EQUAL_P (Book_paper_def);
+Book_paper_def::Book_paper_def ()
+{
+ output_scale_ = 1.0;
+ scaled_fonts_ = SCM_EOL;
+ smobify_self ();
+ scaled_fonts_ = scm_c_make_hash_table (11);
+}
+
+Book_paper_def::~Book_paper_def ()
+{
+}
SCM
Book_paper_def::mark_smob (SCM m)
{
- Book_paper_def * mo = (Book_paper_def*) SCM_CELL_WORD_1 (m);
-
+ Book_paper_def *mo = (Book_paper_def*) SCM_CELL_WORD_1 (m);
return mo->scaled_fonts_;
}
+int
+Book_paper_def::print_smob (SCM s, SCM p, scm_print_state*)
+{
+ (void) s;
+ scm_puts ("#<Book_paper>", p);
+ return 1;
+}
+
Font_metric*
Book_paper_def::find_scaled_font (Font_metric *f, Real m, SCM input_enc_name)
{
Real lookup_mag = m;
if (!dynamic_cast<Virtual_font_metric*> (f))
- {
- lookup_mag /= output_scale_;
- }
+ lookup_mag /= output_scale_;
SCM sizes = scm_hashq_ref (scaled_fonts_, f->self_scm (), SCM_BOOL_F);
if (sizes != SCM_BOOL_F)
Font_metric *scaled = find_scaled_font (unsmob_metrics (ly_car (s)),
m, input_enc_name);
*t = scm_cons (scaled->self_scm (), SCM_EOL);
- t = SCM_CDRLOC(*t);
+ t = SCM_CDRLOC (*t);
}
vf = new Virtual_font_metric (lst);
return unsmob_metrics (val);
}
-
-
-Book_paper_def::Book_paper_def ()
-{
- output_scale_ = 1.0;
- scaled_fonts_ = SCM_EOL;
- smobify_self ();
- scaled_fonts_ = scm_c_make_hash_table (11);
-}
-
-Book_paper_def::~Book_paper_def ()
+Paper_def *
+Book_paper_def::scale_paper (Paper_def *pd) const
{
-}
-
+ SCM proc = ly_scheme_function ("scale-paper");
+ SCM new_pap = scm_call_2 (proc, pd->self_scm (), self_scm ());
+ scm_gc_protect_object (new_pap);
+ Paper_def *p = unsmob_paper (new_pap);
+
+ p->bookpaper_ = (Book_paper_def*) this;
+ return p;
+}
-LY_DEFINE(ly_make_bookpaper, "ly:make-bookpaper",
- 1,0,0,
- (SCM size),
- "Make a paperbook, for staff space SIZE, which is in INTERNAL_UNIT.")
+LY_DEFINE (ly_make_bookpaper, "ly:make-bookpaper",
+ 1, 0, 0,
+ (SCM size),
+ "Make a paperbook, for staff space SIZE, which is in INTERNAL_UNIT.")
{
- Book_paper_def * bp = new Book_paper_def ;
-
- SCM_ASSERT_TYPE(ly_c_number_p (size), size,
- SCM_ARG1, __FUNCTION__, "number");
+ Book_paper_def *bp = new Book_paper_def ;
+ SCM_ASSERT_TYPE (ly_c_number_p (size), size,
+ SCM_ARG1, __FUNCTION__, "number");
bp->output_scale_ = (ly_scm2double (size)) MM;
-
+
return scm_gc_unprotect_object (bp->self_scm ());
}
-
-LY_DEFINE(ly_bookpaper_fonts, "ly:bookpaper-fonts",
- 1,0,0,
- (SCM bp),
- "Return fonts scaled up BP")
+LY_DEFINE (ly_bookpaper_fonts, "ly:bookpaper-fonts",
+ 1, 0, 0,
+ (SCM bp),
+ "Return fonts scaled up BP")
{
- Book_paper_def * b = unsmob_bookpaper (bp);
-
- SCM_ASSERT_TYPE(b, bp,
- SCM_ARG1, __FUNCTION__, "bookpaper");
+ Book_paper_def *b = unsmob_book_paper_def (bp);
+
+ SCM_ASSERT_TYPE (b, bp, SCM_ARG1, __FUNCTION__, "bookpaper");
SCM func = ly_scheme_function ("hash-table->alist");
- SCM l = SCM_EOL;
- for (SCM s = scm_call_1 (func, b->scaled_fonts_); ly_c_pair_p (s); s = ly_cdr (s))
+ SCM ell = SCM_EOL;
+ for (SCM s = scm_call_1 (func, b->scaled_fonts_); ly_c_pair_p (s);
+ s = ly_cdr (s))
{
SCM entry = ly_car (s);
for (SCM t = ly_cdr (entry); ly_c_pair_p (t); t = ly_cdr (t))
{
- Font_metric *fm= unsmob_metrics (ly_cdar (t));
+ Font_metric *fm = unsmob_metrics (ly_cdar (t));
if (dynamic_cast<Modified_font_metric*> (fm))
- l = scm_cons (fm->self_scm (), l);
+ ell = scm_cons (fm->self_scm (), ell);
}
}
- return l;
+ return ell;
}
-LY_DEFINE(ly_bookpaper_outputscale, "ly:bookpaper-outputscale",
- 1,0,0,
+LY_DEFINE (ly_bookpaper_outputscale, "ly:bookpaper-outputscale",
+ 1, 0, 0,
(SCM bp),
"Get outputscale for BP.")
{
- Book_paper_def * b = unsmob_bookpaper (bp);
-
- SCM_ASSERT_TYPE(b, bp,
- SCM_ARG1, __FUNCTION__, "bookpaper");
+ Book_paper_def *b = unsmob_book_paper_def (bp);
+ SCM_ASSERT_TYPE (b, bp, SCM_ARG1, __FUNCTION__, "bookpaper");
return scm_make_real (b->output_scale_);
}
-
-int
-Book_paper_def::print_smob (SCM s, SCM p, scm_print_state*)
-{
- scm_puts ("#<Book_paper>", p);
- return 1;
-}
-
-
-Paper_def *
-Book_paper_def::scale_paper (Paper_def* pd) const
-{
- SCM proc = ly_scheme_function ("scale-paper");
- SCM new_pap = scm_call_2 (proc, pd->self_scm (), self_scm ());
-
- scm_gc_protect_object (new_pap);
-
- Paper_def* p = unsmob_paper (new_pap);
-
- p->bookpaper_ = (Book_paper_def*) this;
- return p;
-}
--- /dev/null
+/*
+ book-paper-def.hh -- declare Book_paper_def
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
+*/
+
+#ifndef BOOK_PAPER_DEF_HH
+#define BOOK_PAPER_DEF_HH
+
+#include "lily-proto.hh"
+#include "smobs.hh"
+#include "virtual-methods.hh"
+
+class Book_paper_def
+{
+ DECLARE_SMOBS (Book_paper_def, Music_output_def);
+
+public:
+ VIRTUAL_COPY_CONSTRUCTOR (Book_paper_def, Book_paper_def);
+
+ SCM scaled_fonts_;
+ Real output_scale_;
+
+ Book_paper_def ();
+
+ Font_metric *find_scaled_font (Font_metric *f, Real m, SCM input_enc_name);
+ Paper_def *scale_paper (Paper_def *pd) const;
+};
+DECLARE_UNSMOB (Book_paper_def, book_paper_def);
+
+#endif /* BOOK_PAPER_DEF_HH */
void process (String outname, Music_output_def*, SCM header);
SCM to_stencil (Music_output_def*, SCM header);
};
-DECLARE_UNSMOB (Book,book);
+DECLARE_UNSMOB (Book, book);
#endif /* BOOK_HH */
get_bookpaper (My_lily_parser *parser)
{
SCM id = parser->lexer_->lookup_identifier ("$defaultbookpaper");
- Book_paper_def *paper = unsmob_bookpaper (id);
- return paper->clone ();
+ Book_paper_def *paper = unsmob_book_paper_def (id);
+ return paper->clone ();
}
{
My_lily_parser *parser = unsmob_my_lily_parser (parser_smob);
Book *book = unsmob_book (book_smob);
- Book_paper_def *bp = unsmob_bookpaper (parser->lexer_->lookup_identifier ("$defaultbookpaper"));
+ Book_paper_def *bp = unsmob_book_paper_def (parser->lexer_->lookup_identifier ("$defaultbookpaper"));
SCM_ASSERT_TYPE (parser, parser_smob, SCM_ARG1, __FUNCTION__, "Lilypond parser");
SCM_ASSERT_TYPE (book, book_smob, SCM_ARG2, __FUNCTION__, "Book");
- book->bookpaper_ = bp; // ugh. changing argument.
+ /* ugh. changing argument.*/
+ book->bookpaper_ = bp;
SCM header = parser->header_;
File_name outname (parser->output_basename_);
{
$$ = new Book;
$$->set_spot (THIS->here_input ());
- $$->bookpaper_ = unsmob_bookpaper (THIS->lexer_->lookup_identifier ("$defaultbookpaper"));
+ $$->bookpaper_ = unsmob_book_paper_def (THIS->lexer_->lookup_identifier ("$defaultbookpaper"));
}
| book_body score_block {
Score *score = $2;
{
SCM context = ly_run_translator (music, outdef);
- Book_paper_def * bpd = unsmob_bookpaper (book_outputdef);
- if (bpd &&
- unsmob_paper (outdef))
- {
- outdef = bpd->scale_paper (unsmob_paper (outdef))->self_scm (); // mem
- // leak.
- }
+ Book_paper_def *bpd = unsmob_book_paper_def (book_outputdef);
+ if (bpd && unsmob_paper (outdef))
+ /* FIXME: memory leak */
+ outdef = bpd->scale_paper (unsmob_paper (outdef))->self_scm ();
if (Global_context *g = dynamic_cast<Global_context*>
(unsmob_context (context)))
--- /dev/null
+;;;; output-gnome.scm -- implement GNOME canvas output
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
+
+
+;;; HIP -- hack in progress
+
+"
+## install gnome-devel
+
+## use guile-1.6 for g-wrap/guile-gnome
+PATH=/usr/bin:$PATH
+
+## get g-wrap 2.0
+tla register-archive http://people.debian.org/~rotty/arch/guile-gnome-devel@gnu.org/2004/4 || true
+
+rm -rf gw-pristine
+tla get a.rottmann@gmx.at--2004-main/g-wrap--tng gw-pristine
+cd gw-pristine
+
+AUTOMAKE=automake-1.8 AUTOCONF=autoconf2.50 sh autogen.sh --noconfigure
+mkdir =build
+cd =build
+../configure --prefix=$HOME/usr/pkg/g-wrap
+make install
+
+cd ../..
+
+## get guile-gnome
+rm -rf gg-pristine
+tla get a.rottmann@gmx.at--2004-main/guile-gnome-dists--dev gg-pristine
+cd gg-pristine
+tla build-config -r configs/gnu.org/dev
+cd src
+AUTOMAKE=automake-1.8 AUTOCONF=autoconf2.50 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
+
+G_WRAP_MODULE_DIR=$HOME/usr/pkg/g-wrap/share/guile/site make install
+#fixup
+(cd $HOME/usr/pkg/guile-gnome/share/guile/gnome && mv gtk/g[dt]k.scm gw)
+
+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/gtk/examples/hello.scm
+
+
+lilypond-bin -fgnome input/simple-song.ly
+
+
+"
+
+
+
+(debug-enable 'backtrace)
+
+(define-module (scm output-gnome))
+(define this-module (current-module))
+
+(use-modules
+ (guile)
+ (lily)
+ (gnome gtk))
+
+
+;;; Lily output interface --- fix silly names and docme
+
+"
+ The output interface has functions for
+ * formatting stencils, and
+ * output commands
+
+ Stencils:
+ beam
+ bezier-sandwich
+ bracket
+ ...
+
+ Commands:
+ define-fonts
+ header
+ placebox
+ ...
+
+
+ The Bare minimum interface for \score { \notes c } } should
+ implement:
+
+ INTERFACE-output-expression
+ char
+ filledbox
+ placebox
+
+ and should intercept:
+"
+
+(define (dummy . foo) #f)
+
+;; 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
+ ))
+
+(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)
+ (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"))
+ ""))))))
+
+
+;;; Global vars
+(define main-window #f)
+(define the-canvas #f)
+
+(define output-scale (* 2 2.83464566929134))
+(define system-y 0)
+(define line-thickness 0.001)
+
+
+(define (char font i)
+ #f)
+
+(define (placebox x y expr)
+ #f)
+
+;; gnome_canvas_item_new (gnome_canvas_root (canvas),
+;; gnome_canvas_rect_get_type (),
+;; "x1", (double) x1,
+;; "y1", (double) y1,
+;; "x2", (double) x2,
+;; "y2", (double) y2,
+;; "fill_color", "black",
+;; "outline_color", "black",
+;; "width_units", 1.0,
+;; NULL);
+
+(define (round-filled-box breapth width depth height blot-diameter)
+ (let* ((x . ,(number->string (* output-scale (- 0 breapth))))
+ (y . ,(number->string (* output-scale (- 0 height))))
+ (width . ,(number->string (* output-scale (+ breapth width))))
+ (height . ,(number->string (* output-scale (+ depth height))))
+ (ry . ,(number->string (/ blot-diameter 2)))
+ ;;(item (make <canvas-item>
+ ;; #:type 'GnomeCanvasLine
+ ;; #:points '(x y width height))
+ )
+ #f))
+
+(define (fontify font expr)
+ #f)
+
+(define (end-output)
+ (gtk-main))
+
+(define (header . rest)
+ (let* ((window (make <gtk-window> #:type 'toplevel))
+ ;;(canvas (make <canvas>))
+ ;;(canvas (make <gnome-canvas>))
+ (button (make <gtk-button> #:label "Hello, World!")))
+
+ (gtk-container-set-border-width window 10)
+ (gtk-container-add window button)
+
+ (gtype-instance-signal-connect button 'clicked
+ (lambda (b) (gtk-main-quit)))
+
+ (gtk-widget-show-all window)
+ (set! main-window window)
+ ;;(set! the-canvas canvas))
+ ))
+
+(define (text . rest)
+ #f)
+
+(define (filledbox a b c d)
+ (round-filled-box a b c d 0.001))
+
+;; WTF is this in every backend?
+(define (horizontal-line x1 x2 th)
+ (filledbox (- x1) (- x2 x1) (* .5 th) (* .5 th)))
;; (tagify "text" (dispatch expr) (cons 'style (get-font font)))))
(tagify "text" expr (cons 'style (get-font font)))))
-(define (utext font s)
+(define (text font s)
(tagify "tspan"
- (apply string-appendb
+ (apply string-append
(map (lambda (x) (ascii->upm-string (char->integer x)))
- (string->list s)))))
+ (string->list s)))
+ (cons 'style (get-font font))))
-(define (text font s)
+(define (ntext font s)
;; (fontify font
;; to unicode or not?
(tagify "tspan" (dispatch `(fontify ,font ,s))))
projects / lilypond.git / commitdiff