From 72d0d9b6ea9151dbb1f204af013d3c3b38e5c4ba Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 23 Sep 2011 14:10:00 -0700 Subject: [PATCH] Finished so that it resizes its resizee. A resizee is now required to create a resizer. Using gtk_grab_add/remove for the first time. Fixed initialization of fix-widget-geometry. Allowing the toplevel to shrink to 10x10. --- src/gtk/fix-demo.scm | 3 +- src/gtk/fix-layout.scm | 118 ++++++++++++++++++++++++++++++++++++----- src/gtk/gtk.cdecl | 6 +++ 3 files changed, 113 insertions(+), 14 deletions(-) diff --git a/src/gtk/fix-demo.scm b/src/gtk/fix-demo.scm index 3e615c368..e17d3b372 100644 --- a/src/gtk/fix-demo.scm +++ b/src/gtk/fix-demo.scm @@ -34,9 +34,10 @@ USA. (scroller2 (gtk-scrolled-window-new)) (layout1 (make-demo-layout 200 200)) (layout2 (make-demo-layout 200 200)) - (resizer (make-fix-resizer -1 10))) + (resizer (make-fix-resizer layout1 -1 10))) (gtk-window-set-opacity window 0.90) (gtk-window-set-title window "fix-layout-demo") + (gtk-window-set-geometry-hints window window 'min-width 10 'min-height 10) (set-gtk-window-delete-event-callback! window (lambda (w) (%trace ";closed "w"\n") 0)) (gtk-container-set-border-width window 10) diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm index 199094017..42e425fd5 100644 --- a/src/gtk/fix-layout.scm +++ b/src/gtk/fix-layout.scm @@ -126,7 +126,7 @@ USA. (error-if-null main-GdkWindow "Could not create main window:" widget) (C-call "gtk_widget_set_window" GtkWidget main-GdkWindow) (C-call "gdk_window_set_user_data" main-GdkWindow GtkWidget) - (set-fix-rect! (fix-widget-geometry widget) #f #f width height) + (set-fix-rect! (fix-widget-geometry widget) x y width height) (%trace "; window: "main-GdkWindow"\n")) (let ((alien (C-> GtkWidget "GtkWidget style"))) @@ -716,8 +716,28 @@ USA. ;;; This is a simple that handles expose events by ;;; calling gtk_paint_handle(). -(define-class ( (constructor () (width height))) - ()) +(define-class ( (constructor (resizee) (width height))) + () + + ;; Inferred from aspect ratio (for now?). + (stack-vertical? define standard) + + ;; The widget that is above or left of this widget. + (resizee define accessor) + + ;; While a gtk_grab_add is in effect, this is the starting position + ;; of the pointer (in parent coords!) and the starting size of the + ;; resizee. + (drag-start define standard initial-value #f)) + +(define-method initialize-instance ((widget ) width height) + (call-next-method widget width height) + (guarantee-fix-widget (fix-resizer-resizee widget) + '(initialize-instance )) + (let ((vertical? (or (and (fix:< width 1) (fix:> height 0)) + (fix:< height width) + (error "Ambiguous verticality:" widget width height)))) + (set-fix-resizer-stack-vertical?! widget vertical?))) (define-method fix-widget-realize-callback ((widget )) (call-next-method widget) @@ -730,7 +750,10 @@ USA. 'sb-v-double-arrow))) (set-fix-widget-expose-handler! widget resizer-expose-handler) (set-fix-widget-enter-notify-handler! widget resizer-enter-handler) - (set-fix-widget-leave-notify-handler! widget resizer-leave-handler)) + (set-fix-widget-leave-notify-handler! widget resizer-leave-handler) + (set-fix-widget-button-handler! widget 'press resizer-press-handler) + (set-fix-widget-button-handler! widget 'release resizer-release-handler) + (set-fix-widget-motion-handler! widget resizer-motion-handler)) (define (resizer-expose-handler resizer x y width height) (declare (ignore x y width height)) @@ -742,27 +765,96 @@ USA. (widget 0) (detail 0) (geom (fix-widget-geometry resizer))) - (let ((orientation (if (fix:< (fix-rect-width geom) - (fix-rect-height geom)) - (C-enum "GTK_ORIENTATION_VERTICAL") - (C-enum "GTK_ORIENTATION_HORIZONTAL")))) + (let ((orientation (if (fix-resizer-stack-vertical? resizer) + (C-enum "GTK_ORIENTATION_HORIZONTAL") + (C-enum "GTK_ORIENTATION_VERTICAL")))) (C-call "gtk_paint_handle" style window state (C-enum "GTK_SHADOW_NONE") clip widget detail - (or (fix-rect-x geom) 0) (or (fix-rect-y geom) 0) + 0 0 ;my gdkwindow's coords. (fix-rect-width geom) (fix-rect-height geom) orientation) #t)))) (define (resizer-enter-handler resizer) - (outf-error ";resizer-enter-handler\n") + (%trace ";resizer-enter-handler\n") (C-call "gtk_widget_set_state" (gobject-alien resizer) (C-enum "GTK_STATE_PRELIGHT"))) (define (resizer-leave-handler resizer) - (outf-error ";resizer-leave-handler\n") - (C-call "gtk_widget_set_state" - (gobject-alien resizer) (C-enum "GTK_STATE_NORMAL"))) + (%trace ";resizer-leave-handler\n") + (if (not (fix-resizer-drag-start resizer)) + (C-call "gtk_widget_set_state" + (gobject-alien resizer) (C-enum "GTK_STATE_NORMAL")))) + +(define (resizer-press-handler resizer type button modifiers x y) +;;; (declare (ignore type)) ;; 'press + (%trace ";resizer-press-handler "type" "button" "modifiers" "x","y"\n") + (if (eq? button 1) + (let* ((geom (fix-widget-geometry resizer)) + (x-parent (fix:+ x (fix-rect-x geom))) + (y-parent (fix:+ y (fix-rect-y geom))) + (geomee (fix-widget-geometry (fix-resizer-resizee resizer))) + (width (fix-rect-width geomee)) + (height (fix-rect-height geomee))) + (%trace "; drag start" + " at "x-parent","y-parent" with "width"x"height"!\n") + (set-fix-resizer-drag-start! resizer (cons (cons x-parent y-parent) + (cons width height))) + (C-call "gtk_grab_add" (gobject-alien resizer))))) + +(define (resizer-release-handler resizer type button modifiers x y) +;;; (declare (ignore type)) ;; 'release + (%trace ";resizer-release-handler "type" "button" "modifiers" "x","y"\n") + (if (fix-resizer-drag-start resizer) + (begin + (%trace "; drag end!\n") + (set-fix-resizer-drag-start! resizer #f) +;;; (C-call "gtk_widget_set_state" +;;; (gobject-alien resizer) (C-enum "GTK_STATE_NORMAL")) + (C-call "gtk_grab_remove" (gobject-alien resizer))))) + +(define (resizer-motion-handler resizer modifiers x y) + (%trace ";resizer-motion-handler "resizer" "modifiers" "x" "y"\n") + (let ((start (fix-resizer-drag-start resizer))) + (if start + (if (equal? modifiers '(button1)) + (let* ((geom (fix-widget-geometry resizer)) + (x-parent (fix:+ x (fix-rect-x geom))) + (y-parent (fix:+ y (fix-rect-y geom))) + (width-start (cadr start)) + (height-start (cddr start)) + (x-start (caar start)) + (y-start (cdar start)) + (width-new + (if (fix-resizer-stack-vertical? resizer) + width-start + ;; Resizee is left; if pointer is right of + ;; start (at greater X), resizee should grow. + (fix:max (fix:+ width-start (fix:- x-parent x-start)) + 2))) + (height-new + (if (fix-resizer-stack-vertical? resizer) + ;; Resizee is above; if pointer is below start + ;; (at greater Y), resizee should grow. + (fix:max (fix:+ height-start (fix:- y-parent y-start)) + 2) + height-start)) + (resizee (fix-resizer-resizee resizer)) + (geomee (fix-widget-geometry resizee)) + (width (fix-rect-width geomee)) + (height (fix-rect-height geomee))) + (if (not (and (fix:= width width-new) + (fix:= height height-new))) + (begin + (%trace "; resizing to "width-new"x"height-new"\n") + (set-fix-widget-size! resizee width-new height-new)) + (begin + (%trace "; fine with "width"x"height"\n")))) + (begin + (%trace "; drag dropped!\n") + (C-call "gtk_grab_remove" (gobject-alien resizer)) + (set-fix-resizer-drag-start! resizer #f)))))) (define-class ( (constructor () no-init)) () diff --git a/src/gtk/gtk.cdecl b/src/gtk/gtk.cdecl index 0b7eb75f1..a0f2159ba 100644 --- a/src/gtk/gtk.cdecl +++ b/src/gtk/gtk.cdecl @@ -94,6 +94,12 @@ USA. (extern void g_free ;glib-2.8.6/glib/gmem.h (mem gpointer)) +(extern void gtk_grab_add ;gtk+-2.24.4/gtk/gtkmain.h + (widget (* GtkWidget))) + +(extern void gtk_grab_remove ;gtk+-2.24.4/gtk/gtkmain.h + (widget (* GtkWidget))) + (extern (* GtkWidget) ;gtk+-2.4.0/gtk/gtkbutton.h gtk_button_new) -- 2.25.1