From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Sat, 7 May 2016 00:29:46 +0000 (-0700)
Subject: gtk/fix-layout.scm: Fix image-ink callback extents.
X-Git-Tag: mit-scheme-pucked-9.2.12~324
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=af526dc086bf8cd85a5ff0f80bd2a79102ddf678;p=mit-scheme.git

gtk/fix-layout.scm: Fix image-ink callback extents.
---

diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm
index ceb8748fc..b5bae9a4a 100644
--- a/src/gtk/fix-layout.scm
+++ b/src/gtk/fix-layout.scm
@@ -867,17 +867,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	     (set-fix-rect-position! extent x y)
 	     (drawing-damage ink)))))))
 
-(define (set-fix-ink-%size! ink width height)
-  (let ((extent (fix-ink-extent ink)))
-    (without-interrupts
-     (lambda ()
-       (if (not (and (fix:= width (fix-rect-width extent))
-		     (fix:= height (fix-rect-height extent))))
-	   (begin
-	     (drawing-damage ink)
-	     (set-fix-rect-size! extent width height)
-	     (drawing-damage ink)))))))
-
 (define (set-fix-ink! ink x y width height)
   (let ((extent (fix-ink-extent ink)))
     (without-interrupts
@@ -1686,7 +1675,13 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (image-ink-size-prepared ink)
   (named-lambda (image-ink-size-prepared-handler width height)
     (%trace ";image-ink-size-prepared-handler "ink" "width" "height"\n")
-    (set-fix-ink-%size! ink width height)))
+    (let ((extent (fix-ink-extent ink)))
+      (if (not (and (fix:= width (fix-rect-width extent))
+		    (fix:= height (fix-rect-height extent))))
+	  (begin
+	    (drawing-damage ink)
+	    (set-fix-rect-size! extent width height)
+	    (drawing-damage ink))))))
 
 (define (image-ink-pixbuf-prepared ink)
   (named-lambda (image-ink-pixbuf-prepared-handler pixbuf)
@@ -1695,7 +1690,11 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (image-ink-pixbuf-updated ink)
   (named-lambda (image-ink-pixbuf-updated-handler x y width height)
-    (let ((rect (make-fix-rect x y width height)))
+    (let* ((extent (fix-ink-extent ink))
+	   (rect (make-fix-rect
+		  (fix:+ x (fix-rect-x extent))
+		  (fix:+ y (fix-rect-y extent))
+		  width height)))
       (%trace ";image-ink-pixbuf-updated-handler "ink" "rect"\n")
       (drawing-damage ink rect))))