From d85b63746dcde2548ea4226308d8e3ecc168f87c Mon Sep 17 00:00:00 2001
From: janneke <janneke>
Date: Wed, 10 Nov 2004 20:21:13 +0000
Subject: [PATCH] (item-event): Add support from TLA. Support animated/opaque
grob dragging tweaks.
---
lily/lily-parser.cc | 5 ++--
scm/framework-gnome.scm | 52 ++++++++++++++++++++---------------------
2 files changed, 28 insertions(+), 29 deletions(-)
diff --git a/lily/lily-parser.cc b/lily/lily-parser.cc
index 1700609a18..96ec79f0e3 100644
--- a/lily/lily-parser.cc
+++ b/lily/lily-parser.cc
@@ -101,8 +101,9 @@ Lily_parser::parse_file (String init, String name, String out_name)
set_yydebug (0);
lexer_->new_input (init, sources_);
-#ifdef TWEAK
- String s = global_path.find (name + ".t");
+#ifdef TWEAK
+ File_name f (name);
+ String s = global_path.find (f.base_ + ".twy");
if (s == "")
Grob_selector::set_tweaks (SCM_EOL);
else
diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm
index c889bd8d6b..59ee4a367c 100644
--- a/scm/framework-gnome.scm
+++ b/scm/framework-gnome.scm
@@ -294,23 +294,21 @@
(cons (car extra-offset)
(- 0 (cdr extra-offset))))))
(if grob (hashq-set! (grob-tweaks go) grob
- (cons (+ (car origin) (car offset))
- (- 0 (+ (cdr origin) (cdr offset))))))
- ;;;(move item (car offset) (cdr offset))))
- ))
+ (cons
+ 'extra-offset
+ (list
+ (cons (+ (car origin) (car offset))
+ (- 0 (+ (cdr origin) (cdr offset))))))))))
+;; FIXME: this only saves new tweaks, old tweaks are lost.
(define-method (save-tweaks (go <gnome-outputter>))
- (let ;;((file (current-error-port)))
- ((file (open-file (string-append (name go) ".ly.t") "w")))
- (format file ";;; TWEAKS \n")
- (format file ";;(define grob-id-tweak-alist \n'(\n")
- (hash-fold
- (lambda (key value seed)
- (format file "(~S extra-offset ~S)\n"
- (if (ly:grob? key) (ly:grob-id key) ";;unidentified grob")
- value))
- #f (grob-tweaks go))
- (format file ")\n;;)\n")))
+ (let ((tweaks (hash-fold
+ (lambda (key value seed)
+ (cons (cons (ly:grob-id key) value) seed))
+ '() (grob-tweaks go))))
+ (if (not (null? tweaks))
+ (let ((file (open-file (string-append (name go) ".twy") "w")))
+ (format file ";;; TWEAKS \n'~S\n" tweaks)))))
;;;(define (item-event go grob item event)
(define (item-event go item event)
@@ -320,21 +318,19 @@
((enter-notify) (gobject-set-property item 'fill-color "red"))
((leave-notify) (gobject-set-property item 'fill-color "black"))
((motion-notify) (if (ly:grob? (dragging go))
- (let* ((x (gdk-event-motion:x event))
- (y (gdk-event-motion:y event))
- ;;(s (pixels-per-unit go))
- (s output-scale)
- (r (drag-location go)))
+ (let ((x (gdk-event-motion:x event))
+ (y (gdk-event-motion:y event))
+ (s output-scale)
+ (r (drag-location go)))
;;(stderr "MOVED AT: ~S ~S\n" x y)
(move item (/ (- x (car r)) s) (/ (- y (cdr r)) s))
(set! (drag-location go) (cons x y)))))
((button-release) (if (ly:grob? (dragging go))
- (let* ((x (gdk-event-button:x event))
- (y (gdk-event-button:y event))
- ;;(s (pixels-per-unit go))
- (s output-scale)
- (o (drag-origin go))
- (r (drag-location go)))
+ (let ((x (gdk-event-button:x event))
+ (y (gdk-event-button:y event))
+ (s output-scale)
+ (o (drag-origin go))
+ (r (drag-location go)))
(move item (/ (- x (car r)) s) (/ (- y (cdr r)) s))
(set! (drag-location go) #f)
(set! (drag-origin go) #f)
@@ -374,7 +370,9 @@
(debugf "GROB: ~S\n" grob)
(debugf "PROPERTIES: ~S\n" properties)
(debugf "BASIC PROPERTIES: ~S\n" basic-properties)
-
+
+ ;; FIXME: dialog iso window?
+ ;; http://www.gtk.org/tutorial/sec-textentries.html
(let ((window (make <gtk-window>))
(vbox (make <gtk-vbox>))
(button (make <gtk-button> #:label "Ok")))
--
2.39.5