gtk: Fixed adjust-adjustments for drawings smaller than the viewport.

Now maximizing the demo works.

diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm
index 9b59d23764b4122a41652bce87f52733d24e7469..b265f2c76e83f82e11f0fc841bd439c47bc9c602 100644 (file)
--- a/src/gtk/fix-layout.scm
+++ b/src/gtk/fix-layout.scm
@@ -374,6 +374,12 @@ USA.
   (let ((drawing (fix-layout-drawing layout)))
     (if drawing (fix-drawing-remove-widget! drawing layout))))
 
+(define-integrable (fix-layout-hstep-incr widget)
+  (car (fix-layout-scroll-step widget)))
+
+(define-integrable (fix-layout-vstep-incr widget)
+  (cdr (fix-layout-scroll-step widget)))
+
 (define (fix-layout-clip-area layout cairo)
   ;; The cairo context is clipped to the exposed area in widget
   ;; coords (window coordinates).
@@ -609,33 +615,62 @@ USA.
   ;; Called after the widget gets new adjustment(s) or its size or
   ;; scrollable extent changes.
 
-  (let ((vadj (fix-layout-vadjustment widget)))
-    (if (and vadj (gobject-live? vadj))
-       (let* ((view (fix-layout-view widget))
-              (view-height (fix-rect-height view))
-              (extent (fix-layout-scrollable-extent widget))
-              (top (fix-rect-y extent))
-              (bottom (fix:+ top (fix:max (fix-rect-height extent) view-height)))
-              (value (fix-rect-y view))
-              (page-size view-height)
-              (step-incr (cdr (fix-layout-scroll-step widget)))
-              (page-incr (min page-size (- page-size step-incr))))
-         (set-gtk-adjustment! vadj value top bottom
-                              page-size step-incr page-incr))))
-
-  (let ((hadj (fix-layout-hadjustment widget)))
-    (if (and hadj (gobject-live? hadj))
-       (let* ((view (fix-layout-view widget))
-              (view-width (fix-rect-width view))
-              (extent (fix-layout-scrollable-extent widget))
-              (left (fix-rect-x extent))
-              (right (fix:+ left (fix:max (fix-rect-width extent) view-width)))
-              (value (fix-rect-x view))
-              (page-size view-width)
-              (step-incr (car (fix-layout-scroll-step widget)))
-              (page-incr (min page-size (- page-size step-incr))))
-         (set-gtk-adjustment! hadj value left right
-                              page-size step-incr page-incr)))))
+  (%trace2 ";adjust horizontal adjustment "widget"\n")
+  (adjust-adjustment widget (fix-layout-hadjustment widget)
+                    fix-rect-width fix-rect-x
+                    (lambda (rect x)
+                      (set-fix-rect-x! rect x)
+                      (gtk-widget-queue-draw widget))
+                    fix-layout-hstep-incr)
+  (%trace2 ";adjust vertical adjustment "widget"\n")
+  (adjust-adjustment widget (fix-layout-vadjustment widget)
+                    fix-rect-height fix-rect-y
+                    (lambda (rect y)
+                      (set-fix-rect-y! rect y)
+                      (gtk-widget-queue-draw widget))
+                    fix-layout-vstep-incr))
+
+(define (adjust-adjustment widget adj
+                          fix-rect-size fix-rect-low set-fix-rect-low!
+                          widget-step-incr)
+  (if (and adj (gobject-live? adj))
+      (let ((view (fix-layout-view widget))
+           (extent (fix-layout-scrollable-extent widget)))
+       (let ((view-size (fix-rect-size view))
+             (extent-size (fix-rect-size extent))
+             (step-incr (widget-step-incr widget)))
+         (if (fix:< view-size extent-size)
+             ;; Drawing is larger than viewport: thumb (page) is viewport.
+             (let ((low (fix-rect-low extent))
+                   (high (fix:+ (fix-rect-low extent) extent-size))
+                   (page-size view-size)
+                   (page-incr (fix:max 1 (fix:- view-size step-incr))))
+               (%trace ";  large-drawing:"extent" view:"view"\n")
+               (let ((value (clamped-value! low (fix:- high page-size))))
+                 (%trace ";    "low" "value" "high" "page-size"\n")
+                 (set-gtk-adjustment! adj value low high
+                                      page-size step-incr page-incr)))
+             ;; Viewport is larger than drawing: thumb (page) is drawing.
+             (let* ((low (fix:- (fix-rect-low extent)
+                                (fix:- view-size extent-size)))
+                    (high (fix:+ (fix-rect-low extent) extent-size))
+                    (page-size extent-size)
+                    (page-incr (fix:max 1 (fix:- extent-size step-incr))))
+               (%trace ";  drawing:"extent" large-view:"view"\n")
+               (let ((value (clamped-value! low (fix:- high page-size))))
+                 (%trace ";    "low" "value" "high" "page-size"\n")
+                 (set-gtk-adjustment! adj value low high
+                                      page-size step-incr page-incr)))))
+
+       (define-integrable (clamped-value! low high)
+         (let ((value (fix-rect-low view)))
+           (cond ((fix:< value low)
+                  (set-fix-rect-low! view low)
+                  low)
+                 ((fix:< high value)
+                  (set-fix-rect-low! view high)
+                  high)
+                 (else value)))))))
 \f
 ;;; This is a simple <fix-widget> that handles the draw signal by
 ;;; calling gtk_render_handle().